Initial commit.

lib/perl5/Selima/Checker/AcctRec.pm

@@ -0,0 +1,210 @@
+# Selima Website Content Management System
+# AcctRec.pm: The accounting record form checker.
+
+#  Copyright (c) 2007-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: 2007-09-22
+
+package Selima::Checker::AcctRec;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+use Selima::CallForm;
+use Selima::ChkFunc;
+use Selima::ShortCut;
+use Selima::DataVars qw($DBH :forms);
+
+# new: Initialize the checker
+sub new : method {
+    local ($_, %_);
+    my ($class, $self);
+    ($class, @_) = @_;
+    $_[1] = "acctrecs" if scalar(@_) < 2 || !defined $_[1];
+    $self = $class->SUPER::new(@_);
+    ${$self->{"maxlens"}}{"amount"} = 9;
+    return $self;
+}
+
+# _check_trx: Check the transaction
+sub _check_trx : method {
+    local ($_, %_);
+    my ($self, $form, $error, $sth, $sql);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("trx");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("trx");
+    # Check if it is filled
+    return {"msg"=>N_("Please select a accounting transaction.")}
+        if $form->param("trx") eq "";
+    # Check if the transaction exists
+    return {"msg"=>N_("This accounting transaction does not exist anymore.  Please select another one.")}
+        if !check_sn_in ${$form->param_fetch("trx")}[0], "accttrx";
+    # OK
+    return;
+}
+
+# _check_type: Check the type
+sub _check_type : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("type");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("type");
+    # Check the option value
+    return {"msg"=>N_("This option is invalid.  Please select a proper type.")}
+        unless $form->param("type") =~ /^(?:debit|credit)$/;
+    # OK
+    return;
+}
+
+# _check_ord: Check the order
+# Use the default order checker
+
+# _check_subj: Check the subject
+sub _check_subj : method {
+    local ($_, %_);
+    my ($self, $form, $error, $sth, $sql);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("subj");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("subj");
+    # Check if it is filled
+    return {"msg"=>N_("Please select a accounting subject.")}
+        if $form->param("subj") eq "";
+    # Check if the subject exists
+    return {"msg"=>N_("This accounting subject does not exist anymore.  Please select another one.")}
+        if !check_sn_in ${$form->param_fetch("subj")}[0], "acctsubj";
+    # Check if this is the last level subject
+    $sql = "SELECT * FROM acctsubj"
+        . " WHERE parent=" . $form->param("subj") . ";\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    return {"msg"=>N_("Only a last-level accounting subject is allowed for an accounting subject.")}
+        if $sth->rows > 0;
+    # OK
+    return;
+}
+
+# _check_summary: Check the summary
+sub _check_summary : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("summary");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("summary");
+    # Skip if it is not filled
+    return if $form->param("summary") eq "";
+    # Check the length
+    return {"msg"=>N_("This summary is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"summary"}]}
+        if length $form->param("summary") > ${$self->{"maxlens"}}{"summary"};
+    # OK
+    return;
+}
+
+# _check_amount: Check the amount
+sub _check_amount : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("amount");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("amount");
+    $_ = $form->param("amount");
+    s/NT\$ ?//;
+    s/,//g;
+    s/\.0+$//;
+    $form->param("amount", $_);
+    # Check if it is filled
+    return {"msg"=>N_("Please fill in the amount.")}
+        if $form->param("amount") eq "";
+    # Check the length
+    return {"msg"=>N_("This amount is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"amount"}]}
+        if length $form->param("amount") > ${$self->{"maxlens"}}{"amount"};
+    # Check if it is a valid positive integer
+    return {"msg"=>N_("Please fill in a positive integer amount.")}
+        unless $form->param("amount") =~ /^\d+$/ && $form->param("amount") > 0;
+    # Set to an integer
+    $_ = $form->param("amount");
+    $_ += 0;
+    $form->param("amount", $_);
+    # OK
+    return;
+}
+
+# _redir_seltrx: Suspend and move to the transaction selection form
+sub _redir_seltrx : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Skip if not requested
+    return if !defined $self->{"form"}->param("seltrx");
+    call_form FORM_ACCTTRX, undef, "import_seltrx";
+}
+
+# _redir_deltrx: Remove the transaction
+sub _redir_deltrx : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Skip if not requested
+    return if !defined $self->{"form"}->param("deltrx");
+    $self->{"form"}->delete("trx");
+    success_redirect undef;
+}
+
+# _redir_selsubj: Suspend and move to the accounting subject selection form
+sub _redir_selsubj : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Skip if not requested
+    return if !defined $self->{"form"}->param("selsubj");
+    call_form FORM_ACCTSUBJ, ["list=lastlv"], "import_selsubj";
+}
+
+# _redir_delsubj: Remove the accounting subject
+sub _redir_delsubj : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Skip if not requested
+    return if !defined $self->{"form"}->param("delsubj");
+    $self->{"form"}->delete("subj");
+    success_redirect undef;
+}
+
+return 1;

lib/perl5/Selima/Checker/AcctSubj.pm

@@ -0,0 +1,147 @@
+# Selima Website Content Management System
+# AcctSubj.pm: The accounting subject form checker.
+
+#  Copyright (c) 2007-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: 2007-08-23
+
+package Selima::Checker::AcctSubj;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+use Selima::CallForm;
+use Selima::FetchRec;
+use Selima::ShortCut;
+use Selima::DataVars qw($DBH);
+
+# new: Initialize the checker
+sub new : method {
+    local ($_, %_);
+    my ($class, $self);
+    ($class, @_) = @_;
+    $_[1] = "acctsubj" if scalar(@_) < 2 || !defined $_[1];
+    $self = $class->SUPER::new(@_);
+    return $self;
+}
+
+# _check_code: Check the code
+sub _check_code : method {
+    my ($self, $form, $error, $sth, $sql);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("code");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("code");
+    # Check if it is filled
+    return {"msg"=>N_("Please fill in the code.")}
+        if $form->param("code") eq "";
+    # Check the length
+    return {"msg"=>N_("This code is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"code"}]}
+        if length $form->param("code") > ${$self->{"maxlens"}}{"code"};
+    # Check if the characters used are valid
+    return {"msg"=>N_("Only numbers are allowed for the code.")}
+        unless $form->param("code") =~ /^\d+$/;
+    # Check if this item is duplicated
+    @_ = qw();
+    push @_, "code=" . $DBH->quote($form->param("code"));
+    push @_, "sn!=" . $self->{"sn"} if $self->{"iscur"};
+    $sql = "SELECT * FROM " . $DBH->quote_identifier($self->{"table"})
+        . " WHERE " . join(" AND ", @_) . ";\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    return {"msg"=>N_("This accounting subject already exists.  You cannot create a duplicated one.")}
+        if $sth->rows > 0;
+    # Check if its parent code exists
+    if (length $form->param("code") > 1) {
+        $_ = substr $form->param("code"), 0, -1;
+        $sql = "SELECT * FROM " . $DBH->quote_identifier($self->{"table"})
+            . " WHERE code=" . $DBH->quote($_) . ";\n";
+        $sth = $DBH->prepare($sql);
+        $sth->execute;
+        return {"msg"=>N_("Accounting subject [_1] does not exist.  You cannot create a subject under that."),
+                "margs"=>[$_]}
+            if $sth->rows == 0;
+    }
+    # OK
+    return;
+}
+
+# _check_parent: Check the parent subject
+sub _check_parent : method {
+    local ($_, %_);
+    my ($self, $form, $error, $sth, $sql, %row);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # "topmost not set" has a different form context
+    return {"msg"=>N_("Please select a parent accounting subject.")}
+        if $self->_missing("topmost");
+    # Regularize it
+    $self->_trim("topmost");
+    # Check the option value
+    return {"msg"=>N_("This option is invalid.  Please select a proper parent accounting subject.")}
+        unless $form->param("topmost") =~ /^(?:true|false)$/;
+    # Check the parent subject if not a topmost subject
+    if ($form->param("topmost") eq "false") {
+        # Check if our code says we are topmost
+        if (!$self->_missing("code")) {
+            $self->_trim("code");
+            return {"msg"=>N_("An accounting subject having its code with a single digit must not have a parent.")}
+                if length $form->param("code") < 2;
+        }
+        # Check if it exists
+        $error = $self->_missing("parent");
+        return $error if defined $error;
+        # Regularize it
+        $self->_trim("parent");
+        # Check if it is filled
+        return {"msg"=>N_("Please select a parent accounting subject.")}
+            if $form->param("parent") eq "";
+        # Check if the parent subject is itself
+        return {"msg"=>N_("An accounting subject cannot belong to itself.  Please select another one.")}
+            if $self->{"iscur"} && $form->param("parent") == $self->{"sn"};
+        # Check if this subject exists
+        %row = fetchrec ${$form->param_fetch("parent")}[0], "acctsubj";
+        return {"msg"=>N_("This parent accounting subject does not exist anymore.  Please select another one.")}
+            if keys %row == 0;
+        # Check if the parent matches our code
+        if (!$self->_missing("code")) {
+            $_ = substr $form->param("code"), 0, -1;
+            return {"msg"=>N_("The parent accounting subject of accounting subject [_1] must be of code [_2], not [_3]."),
+                    "margs"=>[$form->param("code"), $_, $row{"code"}]}
+                if $row{"code"} ne $_;
+        }
+    # Check the parent subject if a topmost subject
+    } else {
+        # Check if our code says we are not topmost
+        if (!$self->_missing("code")) {
+            $self->_trim("code");
+            return {"msg"=>N_("An accounting subject having its code with more than one digit must have a parent.")}
+                if length $form->param("code") > 1;
+        }
+    }
+    # OK
+    return;
+}
+
+# _check_title: Check the title
+# Use the default title checker
+
+return 1;

lib/perl5/Selima/Checker/AcctTrx.pm

@@ -0,0 +1,268 @@
+# Selima Website Content Management System
+# AcctTrx.pm: The accounting transaction form checker.
+
+#  Copyright (c) 2007-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: 2007-09-22
+
+package Selima::Checker::AcctTrx;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+use Selima::Accounting;
+use Selima::CallForm;
+use Selima::ChkFunc;
+use Selima::FetchRec;
+use Selima::ShortCut;
+use Selima::DataVars qw($DBH :forms);
+
+use Selima::Checker::AcctRec;
+
+# new: Initialize the checker
+sub new : method {
+    local ($_, %_);
+    my ($class, $self);
+    ($class, @_) = @_;
+    $_[1] = "accttrx" if scalar(@_) < 2 || !defined $_[1];
+    $self = $class->SUPER::new(@_);
+    # Regularize the form subtype
+    $self->_trim("formsub") if !$self->_missing("formsub");
+    # Record the form subtype
+    $self->{"subtype"} = $self->{"form"}->param("formsub");
+    return $self;
+}
+
+# _check_date: Check the date
+# Use the default date checker
+
+# _check_ord: Check the order
+# Use the default order checker
+
+# _check_recs: Check the records
+sub _check_recs : method {
+    local ($_, %_);
+    my ($self, $form, $error, $debtcount, $crdtcount);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check the subtype
+    # Check if it exists
+    $error = $self->_missing("formsub");
+    return $error if defined $error;
+    # Check the option value
+    return {"msg"=>N_("This form suptype is invalid.  Please specify a proper user.")}
+        unless $self->{"subtype"} =~ /^(?:expense|income|trans)$/;
+    # A form to fill in a cash expense transaction
+    if ($self->{"subtype"} eq "expense") {
+        $crdtcount = 0;
+    } else {
+        # Find the last-used credit record
+        for (   $_ = 0;
+                defined $form->param("crdt$_" . "subj")
+                && defined $form->param("crdt$_" . "summary")
+                && defined $form->param("crdt$_" . "amount"); $_++) {};
+        if ($_ > 0) {
+            for (   $_--;
+                    $_ >= 0
+                    && $form->param("crdt$_" . "subj") eq ""
+                    && $form->param("crdt$_" . "summary") eq ""
+                    && $form->param("crdt$_" . "amount") eq ""; $_--) {};
+        }
+        $crdtcount = $_ + 1;
+        if ($crdtcount == 0) {
+            return {"msg"=>N_("Please fill in the credit side of the accounting transaction.")}
+                if $self->{"subtype"} eq "trans";
+            return {"msg"=>N_("Please fill in the accounting transaction content.")};
+        }
+    }
+    # A form to fill in a cash income transaction
+    if ($self->{"subtype"} eq "income") {
+        $debtcount = 0;
+    } else {
+        # Find the last-used debit record
+        for (   $_ = 0;
+                defined $form->param("debt$_" . "subj")
+                && defined $form->param("debt$_" . "summary")
+                && defined $form->param("debt$_" . "amount"); $_++) {};
+        if ($_ > 0) {
+            for (   $_--;
+                    $_ >= 0
+                    && $form->param("debt$_" . "subj") eq ""
+                    && $form->param("debt$_" . "summary") eq ""
+                    && $form->param("debt$_" . "amount") eq ""; $_--) {};
+        }
+        $debtcount = $_ + 1;
+        if ($debtcount == 0) {
+            return {"msg"=>N_("Please fill in the debit side of the accounting transaction.")}
+                if $self->{"subtype"} eq "trans";
+            return {"msg"=>N_("Please fill in the accounting transaction content.")};
+        }
+    }
+    # Check the debit records
+    for ($_ = 0; $_ < $debtcount; $_++) {
+        my ($subform, $checker, $error);
+        # Regularize it
+        $self->_trim("debt$_" . "subj");
+        $self->_trim("debt$_" . "summary");
+        $self->_trim("debt$_" . "amount");
+        # Skip if it is not filled
+        next if $form->param("debt$_" . "subj") eq ""
+                && $form->param("debt$_" . "summary") eq ""
+                && $form->param("debt$_" . "amount") eq "";
+        # Check with the subform checker
+        $subform = new CGI("");
+        $subform->param("trx", $self->{"sn"}) if $self->{"iscur"};
+        $subform->param("subj", $form->param("debt$_" . "subj"));
+        $subform->param("summary", $form->param("debt$_" . "summary"));
+        $subform->param("amount", $form->param("debt$_" . "amount"));
+        $checker = new Selima::Checker::AcctRec($subform);
+        $error = $checker->check("subj", "summary", "amount");
+        return $error if defined $error;
+        $form->param("debt$_" . "subj", $subform->param("subj"));
+        $form->param("debt$_" . "summary", $subform->param("summary"));
+        $form->param("debt$_" . "amount", $subform->param("amount"));
+    }
+    # Check the credit records
+    for ($_ = 0; $_ < $crdtcount; $_++) {
+        my ($subform, $checker, $error);
+        # Regularize it
+        $self->_trim("crdt$_" . "subj");
+        $self->_trim("crdt$_" . "summary");
+        $self->_trim("crdt$_" . "amount");
+        # Skip if it is not filled
+        next if $form->param("crdt$_" . "subj") eq ""
+                && $form->param("crdt$_" . "summary") eq ""
+                && $form->param("crdt$_" . "amount") eq "";
+        # Check with the subform checker
+        $subform = new CGI("");
+        $subform->param("trx", $self->{"sn"}) if $self->{"iscur"};
+        $subform->param("subj", $form->param("crdt$_" . "subj"));
+        $subform->param("summary", $form->param("crdt$_" . "summary"));
+        $subform->param("amount", $form->param("crdt$_" . "amount"));
+        $checker = new Selima::Checker::AcctRec($subform);
+        $error = $checker->check("subj", "summary", "amount");
+        return $error if defined $error;
+        $form->param("crdt$_" . "subj", $subform->param("subj"));
+        $form->param("crdt$_" . "summary", $subform->param("summary"));
+        $form->param("crdt$_" . "amount", $subform->param("amount"));
+    }
+    # Check the balance
+    if ($self->{"subtype"} eq "trans") {
+        my ($sumdebit, $sumcredit);
+        for ($_ = 0, $sumdebit = 0; $_ < $debtcount; $_++) {
+            # Skip if it is not filled
+            next if $form->param("debt$_" . "amount") eq "";
+            $sumdebit += $form->param("debt$_" . "amount");
+        }
+        for ($_ = 0, $sumcredit = 0; $_ < $crdtcount; $_++) {
+            # Skip if it is not filled
+            next if $form->param("crdt$_" . "amount") eq "";
+            $sumcredit += $form->param("crdt$_" . "amount");
+        }
+        return {"msg"=>N_("The total amounts of the debit side and the credit side are not balanced (debit [_1], credit [_2]."),
+                "margs"=>[$sumdebit, $sumcredit]}
+            if $sumdebit != $sumcredit;
+    }
+    return;
+}
+
+# _check_note: Check the note
+sub _check_note : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("note");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trimtext("note");
+    # Skip if it is not filled
+    $form->param("note", "")
+        if $form->param("note") eq C_("Fill in the note here.");
+    return if $form->param("note") eq "";
+    # Check the length
+    return {"msg"=>N_("This note is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"note"}]}
+        if length $form->param("note") > ${$self->{"maxlens"}}{"note"};
+    # OK
+    return;
+}
+
+# _redir_cnvttrans: Convert to a transfer transaction
+sub _redir_cnvttrans : method {
+    local ($_, %_);
+    my ($self, $form, $sum);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Skip if not requested
+    return if $self->_missing("cnvttrans");
+    # Skip if the form subtype not supplied
+    return if !defined $self->{"subtype"};
+    # Skip if it is not an cash expense/income transaction
+    return if $self->{"subtype"} !~ /^(?:expense|income)$/;
+    # Set to a transfer transaction
+    $form->param("formsub", "trans");
+    # Set the other side
+    # A form to fill in a cash expense transaction
+    if ($self->{"subtype"} eq "expense") {
+        $form->param("crdt0subj", acctsubj_sn(ACCTSUBJ_CASH));
+        $form->param("crdt0summary", undef);
+        $sum = 0;
+        foreach (grep /^debt\d+amount$/, $form->param) {
+            $self->_trim($_);
+            $_ = $form->param($_);
+            s/NT\$ ?//;
+            s/,//g;
+            s/\.0+$//;
+            $sum += $_ if /^\d+$/;
+        }
+        $form->param("crdt0amount", $sum);
+    # A form to fill in a cash income transaction
+    } elsif ($self->{"subtype"} eq "income") {
+        $form->param("debt0subj", acctsubj_sn(ACCTSUBJ_CASH));
+        $form->param("debt0summary", undef);
+        $sum = 0;
+        foreach (grep /^crdt\d+amount$/, $form->param) {
+            $self->_trim($_);
+            $_ = $form->param($_);
+            s/NT\$ ?//;
+            s/,//g;
+            s/\.0+$//;
+            $sum += $_ if /^\d+$/;
+        }
+        $form->param("debt0amount", $sum);
+    }
+    # Show the form again
+    success_redirect undef;
+}
+
+# _redir_selsubj: Suspend and move to the accounting subject selection form
+sub _redir_selsubj : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    @_ = sort grep /^sel(?:debt|crdt)\d+subj$/, $self->{"form"}->param;
+    # Skip if not requested
+    return if @_ == 0;
+    # Record the hit button
+    $_[0] =~ /^sel((?:debt|crdt)\d+)subj$/;
+    $self->{"form"}->param("caller_index", $1);
+    call_form FORM_ACCTSUBJ, ["list=lastlv"], "import_selsubj";
+}
+
+return 1;

lib/perl5/Selima/Checker/Group.pm

@@ -0,0 +1,218 @@
+# Selima Website Content Management System
+# Group.pm: The account group form checker.
+
+#  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-10-12
+
+package Selima::Checker::Group;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+use Selima::CallForm;
+use Selima::ChkPriv;
+use Selima::DataVars qw($DBH :forms);
+use Selima::ShortCut;
+use Selima::UserName;
+
+use Selima::Checker::UserMem;
+use Selima::Checker::GroupMem;
+
+# new: Initialize the checker
+sub new : method {
+    local ($_, %_);
+    my $class;
+    ($class, @_) = @_;
+    $_[1] = "groups" if scalar(@_) < 2 || !defined $_[1];
+    return $class->SUPER::new(@_);
+}
+
+# _check_id: Check the group ID.
+sub _check_id : method {
+    local ($_, %_);
+    my ($self, $form, $error, $sth, $sql);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Skip for a non-super-user editing a super-user group
+    return if $self->{"iscur"} && !is_su && $self->{"sn"} == su_group_sn;
+    # Check if it exists
+    $error = $self->_missing("id");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("id");
+    # Check if it is filled
+    return {"msg"=>N_("Please fill in the group ID.")}
+        if $form->param("id") eq "";
+    # Check the length
+    return {"msg"=>N_("This group ID. is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"id"}]}
+        if length $form->param("id") > ${$self->{"maxlens"}}{"id"};
+    return {"msg"=>N_("This group ID. is too short.  (Min. length [#,_1])"),
+            "margs"=>[${$self->{"minlens"}}{"id"}]}
+        if length $form->param("id") < ${$self->{"minlens"}}{"id"};
+    # Check if the characters used are valid
+    return {"msg"=>N_("Only lower-case English letters, numbers and underscores are allowed for the group ID.")}
+        unless $form->param("id") =~ /^[a-z][a-z0-9_]*$/;
+    # Check if this item is duplicated
+    @_ = qw();
+    push @_, "id=" . $DBH->quote($form->param("id"));
+    push @_, "sn!=" . $self->{"sn"} if $self->{"iscur"};
+    $sql = "SELECT * FROM " . $DBH->quote_identifier($self->{"table"})
+        . " WHERE " . join(" AND ", @_) . ";\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    return {"msg"=>N_("This group already exists.  You cannot create a duplicated one.")}
+        if $sth->rows > 0;
+    # OK
+    return;
+}
+
+# _check_dsc: Check the group description
+sub _check_dsc : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("id");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("dsc");
+    # Check if it is filled
+    return {"msg"=>N_("Please fill in the privilege description.")}
+        if $form->param("dsc") eq "";
+    # Check the length
+    return {"msg"=>N_("This privilege description is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"dsc"}]}
+        if length $form->param("dsc") > ${$self->{"maxlens"}}{"dsc"};
+    # OK
+    return;
+}
+
+# _check_subuser: Check the user members
+sub _check_subuser : method {
+    local ($_, %_);
+    my ($self, $form, $error, $subform, $checker);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Skip for a non-super-user editing a super-user group
+    return if $self->{"iscur"} && !is_su && $self->{"sn"} == su_group_sn;
+    # Get the selected items
+    @_ = map $_ . "sn",
+        grep /^subuser\d+/ && defined $form->param($_ . "sn"), $form->param;
+    # Regularize them
+    $self->_trim(@_);
+    # Merge the duplicates
+    %_ = map { ($form->param($_))[0] => 1 } @_;
+    $subform = new CGI("");
+    $subform->param("grp", $self->{"sn"}) if $self->{"iscur"};
+    foreach (keys %_) {
+        $subform->param("member", $_);
+        $checker = new Selima::Checker::UserMem($subform);
+        $error = $checker->check("member");
+        return $error if defined $error;
+    }
+    # OK
+    return;
+}
+
+# _check_subgroup: Check the group members
+sub _check_subgroup : method {
+    local ($_, %_);
+    my ($self, $form, $error, $subform, $checker);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Skip for a non-super-user editing a super-user group
+    return if $self->{"iscur"} && !is_su && $self->{"sn"} == su_group_sn;
+    # Get the selected items
+    @_ = map $_ . "sn",
+        grep /^subgroup\d+/ && defined $form->param($_ . "sn"), $form->param;
+    # Regularize them
+    $self->_trim(@_);
+    # Merge the duplicates
+    %_ = map { ($form->param($_))[0] => 1 } @_;
+    $subform = new CGI("");
+    $subform->param("grp", $self->{"sn"}) if $self->{"iscur"};
+    foreach (keys %_) {
+        $subform->param("member", $_);
+        $checker = new Selima::Checker::GroupMem($subform);
+        $error = $checker->check("member");
+        return $error if defined $error;
+    }
+    # OK
+    return;
+}
+
+# _check_supgroup: Check the belonging groups
+sub _check_supgroup : method {
+    local ($_, %_);
+    my ($self, $form, $error, $subform, $checker);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Skip for a non-super-user editing a super-user group
+    return if $self->{"iscur"} && !is_su && $self->{"sn"} == su_group_sn;
+    # Get the selected items
+    @_ = map $_ . "sn",
+        grep /^supgroup\d+/ && defined $form->param($_ . "sn"), $form->param;
+    # Regularize them
+    $self->_trim(@_);
+    # Merge the duplicates
+    %_ = map { ($form->param($_))[0] => 1 } @_;
+    $subform = new CGI("");
+    $subform->param("member", $self->{"sn"}) if $self->{"iscur"};
+    foreach (keys %_) {
+        $subform->param("grp", $_);
+        $checker = new Selima::Checker::GroupMem($subform);
+        $error = $checker->check("grp");
+        return $error if defined $error;
+    }
+    # OK
+    return;
+}
+
+# _redir_selsubuser: Suspend and move to the subordinate user selection form
+sub _redir_selsubuser : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Skip if not requested
+    return if $self->_missing("selsubuser");
+    call_form FORM_USERS, undef, "import_selsubuser";
+}
+
+# _redir_selsubgroup: Suspend and move to the subordinate group selection form
+sub _redir_selsubgroup : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Skip if not requested
+    return if $self->_missing("selsubgroup");
+    call_form FORM_GROUPS, undef, "import_selsubgroup";
+}
+
+# _redir_selsupgroup: Suspend and move to the superordinate group selection form
+sub _redir_selsupgroup : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Skip if not requested
+    return if $self->_missing("selsupgroup");
+    call_form FORM_GROUPS, undef, "import_selsupgroup";
+}
+
+return 1;

lib/perl5/Selima/Checker/GroupMem.pm

@@ -0,0 +1,143 @@
+# Selima Website Content Management System
+# GroupMem.pm: The group-to-group membership form checker.
+
+#  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-10-13
+
+package Selima::Checker::GroupMem;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+use Selima::ChkFunc;
+use Selima::CallForm;
+use Selima::DataVars qw($DBH :forms);
+use Selima::ShortCut;
+
+# new: Initialize the checker
+sub new : method {
+    local ($_, %_);
+    my $class;
+    ($class, @_) = @_;
+    $_[1] = "groupmem" if scalar(@_) < 2 || !defined $_[1];
+    return $class->SUPER::new(@_);
+}
+
+# check: Run a list of checks
+sub check : method {
+    local ($_, %_);
+    my ($self, $error, @cols);
+    ($self, @cols) = @_;
+    # Run the parent method first
+    $error = $self->SUPER::check(@cols);
+    return $error if defined $error;
+    # See if we need to check the duplicates.  Check it in the end.
+    %_ = map { $_ => 1 } @cols;
+    if (exists $_{"grp"} && exists $_{"member"}) {
+        $error = $self->__check_dup();
+        return $error if defined $error;
+    }
+    return;
+}
+
+# _check_grp: Check the group
+sub _check_grp : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Run the default group checker
+    $error = $self->SUPER::_check_grp;
+    return $error if defined $error;
+    # Check if the group and the member are different
+    return {"msg"=>N_("Please select a different belonging group.")}
+        if  !$self->_missing("member")
+            && $form->param("member") ne ""
+            && $form->param("grp") == $form->param("member");
+    # OK
+    return;
+}
+
+# _check_member: Check the member
+sub _check_member : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("member");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("member");
+    # Check if it is filled
+    return {"msg"=>N_("Please select a member.")}
+        if $form->param("member") eq "";
+    # Check if this group exists
+    return {"msg"=>N_("This member does not exist anymore.  Please select another one.")}
+        if !check_sn_in ${$form->param_fetch("member")}[0], "groups AS grpmembers";
+    # Check if the group and the member are different
+    return {"msg"=>N_("Please select a different group member.")}
+        if  !$self->_missing("grp")
+            && $form->param("grp") ne ""
+            && $form->param("grp") == $form->param("member");
+    # OK
+    return;
+}
+
+# __check_dup: Check if this item is duplicated
+sub __check_dup : method {
+    local ($_, %_);
+    my ($self, $form, $error, $sth, $sql);
+    $self = $_[0];
+    $form = $self->{"form"};
+    @_ = qw();
+    push @_, "grp=" . $form->param("grp");
+    push @_, "member=" . $form->param("member");
+    push @_, "sn!=" . $self->{"sn"}
+        if $self->{"iscur"};
+    $sql = "SELECT * FROM " . $DBH->quote_identifier($self->{"table"})
+        . " WHERE " . join(" AND ", @_) . ";\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    return {"msg"=>N_("This membership record already exists.  You cannot create a duplicated one.")}
+        if $sth->rows > 0;
+    return;
+}
+
+# _redir_selmember: Suspend and move to the member selection form
+sub _redir_selmember : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Skip if not requested
+    return if $self->_missing("selmember");
+    call_form FORM_GROUPS, undef, "import_selmember";
+}
+
+# _redir_delmember: Remove the member
+sub _redir_delmember : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Skip if not requested
+    return if $self->_missing("delmember");
+    $self->{"form"}->delete("member");
+    success_redirect undef;
+}
+
+return 1;

lib/perl5/Selima/Checker/Guestbook.pm

@@ -0,0 +1,157 @@
+# Selima Website Content Management System
+# Guestbook.pm: The base administrative guestbook form checker.
+
+#  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-10-14
+
+package Selima::Checker::Guestbook;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+use Selima::ShortCut;
+
+# new: Initialize the checker
+sub new : method {
+    local ($_, %_);
+    my ($class, $self);
+    ($class, @_) = @_;
+    $_[1] = "guestbook" if scalar(@_) < 2 || !defined $_[1];
+    $self = $class->SUPER::new(@_);
+    ${$self->{"maxlens"}}{"message"} = 10240;
+    return $self;
+}
+
+# _check_name: Check the name
+sub _check_name : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("name");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("name");
+    # Check the length
+    return {"msg"=>N_("This signature is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"name"}]}
+        if length $form->param("name") > ${$self->{"maxlens"}}{"name"};
+    # OK
+    return;
+}
+
+# _check_name_req: Check the name (required)
+sub _check_name_req : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("name");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("name");
+    # Check if it is filled
+    return {"msg"=>N_("Please fill in the signature.")}
+        if $form->param("name") eq "";
+    # Check the length
+    return {"msg"=>N_("This signature is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"name"}]}
+        if length $form->param("name") > ${$self->{"maxlens"}}{"name"};
+    # OK
+    return;
+}
+
+# _check_identity: Check the identity
+sub _check_identity : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("identity");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("identity");
+    # Check the length
+    return {"msg"=>N_("This identity is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"identity"}]}
+        if length $form->param("identity") > ${$self->{"maxlens"}}{"identity"};
+    # OK
+    return;
+}
+
+# _check_location: Check the location
+sub _check_location : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("location");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("location");
+    # Check the length
+    return {"msg"=>N_("This location is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"location"}]}
+        if length $form->param("location") > ${$self->{"maxlens"}}{"location"};
+    # OK
+    return;
+}
+
+# _check_email: Check the e-mail
+sub _check_email : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("email");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("email");
+    # Check the length
+    return {"msg"=>N_("This e-mail is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"email"}]}
+        if length $form->param("email") > ${$self->{"maxlens"}}{"email"};
+    # OK
+    return;
+}
+
+# _check_url: Check the URL
+sub _check_url : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("url");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("url");
+    # Check the length
+    return {"msg"=>N_("This website URL is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"url"}]}
+        if length $form->param("url") > ${$self->{"maxlens"}}{"url"};
+    # OK
+    return;
+}
+
+return 1;

lib/perl5/Selima/Checker/Guestbook/Public.pm

@@ -0,0 +1,224 @@
+# Selima Website Content Management System
+# Public.pm: The base guestbook form checker.
+
+#  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-10-23
+
+package Selima::Checker::Guestbook::Public;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker::Guestbook);
+
+use URI::Find qw();
+
+use Selima::DataVars qw($DBH :lninfo);
+use Selima::GetLang;
+use Selima::HTTP;
+use Selima::ShortCut;
+
+use vars qw($uri_finder);
+
+# _check_name: Check the name
+sub _check_name : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("name");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("name");
+    # Skip if it is not filled
+    return if $form->param("name") eq "";
+    # Check the length
+    return {"msg"=>N_("Your signature is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"name"}]}
+        if length $form->param("name") > ${$self->{"maxlens"}}{"name"};
+    # OK
+    return;
+}
+
+# _check_name_req: Check the name (required)
+sub _check_name_req : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("name");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("name");
+    # Check if it is filled
+    return {"msg"=>N_("Please fill in your signature.")}
+        if $form->param("name") eq "";
+    # Check the length
+    return {"msg"=>N_("Your signature is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"name"}]}
+        if length $form->param("name") > ${$self->{"maxlens"}}{"name"};
+    # OK
+    return;
+}
+
+# _check_identity: Check the identity
+sub _check_identity : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("identity");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("identity");
+    # Skip if it is not filled
+    return if $form->param("identity") eq "";
+    # Check the length
+    return {"msg"=>N_("Your identity is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"identity"}]}
+        if length $form->param("identity") > ${$self->{"maxlens"}}{"identity"};
+    # OK
+    return;
+}
+
+# _check_location: Check the location
+sub _check_location : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("location");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("location");
+    # Skip if it is not filled
+    return if $form->param("location") eq "";
+    # Check the length
+    return {"msg"=>N_("Your location is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"location"}]}
+        if length $form->param("location") > ${$self->{"maxlens"}}{"location"};
+    # OK
+    return;
+}
+
+# _check_email: Check the e-mail
+sub _check_email : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("email");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("email");
+    # Skip if it is not filled
+    return if $form->param("email") eq "";
+    # Check the length
+    return {"msg"=>N_("Your e-mail is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"email"}]}
+        if length $form->param("email") > ${$self->{"maxlens"}}{"email"};
+    # OK
+    return;
+}
+
+# _check_url: Check the URL
+sub _check_url : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("url");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("url");
+    # Skip if it is not filled
+    return if $form->param("url") eq "";
+    # Check the length
+    return {"msg"=>N_("Your website URL is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"url"}]}
+        if length $form->param("url") > ${$self->{"maxlens"}}{"url"};
+    # OK
+    return;
+}
+
+# _check_message: The default message checker
+sub _check_message : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("message");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trimtext("message");
+    # Check if it is filled
+    $form->param("message", "")
+        if $form->param("message") eq C_("Fill in your message here.");
+    return {"msg"=>N_("Please fill in your message.")}
+        if $form->param("message") eq "";
+    # Check the length
+    return {"msg"=>N_("Your message is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"message"}]}
+        if length $form->param("message") > ${$self->{"maxlens"}}{"message"};
+    # OK
+    return;
+}
+
+# _check_flood: Check the flooding attack
+sub _check_flood : method {
+    local ($_, %_);
+    my ($self, $form, $sth, $sql);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # At most 5 posts/hours from a single IP
+    $sql = "SELECT count(*) AS count FROM " . $DBH->quote_identifier($self->{"table"})
+        . " WHERE created > now() - cast('1 hour' AS interval)"
+        . " AND ip='" . $ENV{"REMOTE_ADDR"} . "';\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    return {"msg"=>N_("You can post at most 5 messages in 1 hour.")}
+        if ${$sth->fetch}[0] > 5;
+    # OK
+    return;
+}
+
+# _check_dup: Check the duplicated message
+sub _check_dup : method {
+    local ($_, %_);
+    my ($self, $form, $sth, $sql);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # No duplicated message in the recent 5 posts
+    $sql = "SELECT message FROM " . $DBH->quote_identifier($self->{"table"})
+        . " ORDER BY created DESC LIMIT 5;\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    for ($_ = 0; $_ < $sth->rows; $_++) {
+        return {"msg"=>N_("Your message is already posted.")}
+            if ${$sth->fetch}[0] eq $form->param("message");
+    }
+    # OK
+    return;
+}
+
+return 1;

lib/perl5/Selima/Checker/Link.pm

@@ -0,0 +1,252 @@
+# Selima Website Content Management System
+# Link.pm: The related-link form checker.
+
+#  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-10-24
+
+package Selima::Checker::Link;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+use Email::Valid;
+
+use Selima::ChkFunc;
+use Selima::DataVars qw($DBH);
+use Selima::ShortCut;
+
+# new: Initialize the checker
+sub new : method {
+    local ($_, %_);
+    my ($class, $self);
+    ($class, @_) = @_;
+    $_[1] = "links" if scalar(@_) < 2 || !defined $_[1];
+    $self = $class->SUPER::new(@_);
+    ${$self->{"minlens"}}{"email"} = 5;
+    return $self;
+}
+
+# _check_addr: Check the address
+sub _check_addr : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("addr");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("addr");
+    # Skip if it is not filled
+    return if $form->param("addr") eq "";
+    # Check the length
+    return {"msg"=>N_("This address is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"addr"}]}
+        if length $form->param("addr") > ${$self->{"maxlens"}}{"addr"};
+    # OK
+    return;
+}
+
+# _check_cats: Check the categories list
+sub _check_cats : method {
+    local ($_, %_);
+    my ($self, $form, $error, $val);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Loop each category
+    for ($_ = 0, %_ = qw(); !$self->_missing("cat$_"); $_++) {
+        # Regularize it
+        $self->_trim("cat$_");
+        # Skip if it is not filled
+        next if $form->param("cat$_") eq "";
+        # Check if this selection is duplicated
+        return {"msg"=>N_("This category is duplicated.  You cannot set duplicated ones.")}
+            if exists $_{$form->param("cat$_")};
+        # Check if the category exists
+        return {"msg"=>N_("This category does not exist anymore.  Please select another one.")}
+            if !check_sn_in ${$form->param_fetch("cat$_")}[0], "linkcat";
+        $_{$form->param("cat$_")} = 1;
+    }
+    # Check if there is any category selected
+    return {"msg"=>N_("Please select a category.")}
+        if scalar(keys %_) == 0;
+    # OK
+    return;
+}
+
+# _check_email: Check the e-mail
+sub _check_email : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("email");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("email");
+    # Skip if it is not filled
+    return if $form->param("email") eq "";
+    # Check the length
+    return {"msg"=>N_("This e-mail is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"email"}]}
+        if length $form->param("email") > ${$self->{"maxlens"}}{"email"};
+    return {"msg"=>N_("This e-mail is too short.  (Min. length [#,_1])"),
+            "margs"=>[${$self->{"minlens"}}{"email"}]}
+        if length $form->param("email") < ${$self->{"minlens"}}{"email"};
+    # Check the e-mail validity
+    return {"msg"=>N_("Please fill in a valid e-mail address.")}
+        if !Email::Valid->rfc822($form->param("email"));
+    return {"msg"=>N_("The domain of this e-mail does not exists.  Check if there is any typo in it.")}
+        if  $self->_missing("hid")
+            && !Email::Valid->mx($form->param("email"));
+    # OK
+    return;
+}
+
+# _check_fax: Check the facsimile number
+sub _check_fax : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("fax");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("fax");
+    # Skip if it is not filled
+    return if $form->param("fax") eq "";
+    # Check the length
+    return {"msg"=>N_("This facsimile number is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"fax"}]}
+        if length $form->param("fax") > ${$self->{"maxlens"}}{"fax"};
+    # OK
+    return;
+}
+
+# _check_icon: Check the link icon
+sub _check_icon : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("icon");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("icon");
+    # Skip if it is not filled
+    return if $form->param("icon") eq "" || $form->param("icon") eq "http://";
+    # Check the length
+    return {"msg"=>N_("This link icon URL is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"icon"}]}
+        if length $form->param("icon") > ${$self->{"maxlens"}}{"icon"};
+    # Check its format
+    return {"msg"=>N_("Please fill in a valid link icon URL.")}
+        if !is_url_wellformed $form->param("icon");
+    # Check if it is available
+    return {"msg"=>N_("This link icon URL is not reachable.  Check if there is any typo in it.")}
+        if  $self->_missing("hid")
+            && !is_url_reachable $form->param("icon");
+    # OK
+    return;
+}
+
+# _check_tel: Check the telephone number
+sub _check_tel : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("tel");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("tel");
+    # Skip if it is not filled
+    return if $form->param("tel") eq "";
+    # Check the length
+    return {"msg"=>N_("This telephone number is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"tel"}]}
+        if length $form->param("tel") > ${$self->{"maxlens"}}{"tel"};
+    # OK
+    return;
+}
+
+# _check_title_2ln: The 2nd language title checker
+sub _check_title_2ln : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("title_2ln");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("title_2ln");
+    # Skip if it is not filled
+    return if $form->param("title_2ln") eq "";
+    # Check the length
+    return {"msg"=>N_("This 2nd language title is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"title_2ln"}]}
+        if length $form->param("title_2ln") > ${$self->{"maxlens"}}{"title_2ln"};
+    # OK
+    return;
+}
+
+# _check_url: The URL checker
+sub _check_url : method {
+    local ($_, %_);
+    my ($self, $form, $error, $sth, $sql);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("url");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("url");
+    # Check if it is filled
+    return {"msg"=>N_("Please fill in the URL.")}
+        if $form->param("url") eq "" || $form->param("url") eq "http://";
+    # Check the length
+    return {"msg"=>N_("This URL is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"url"}]}
+        if length $form->param("url") > ${$self->{"maxlens"}}{"url"};
+    # Check its format
+    return {"msg"=>N_("Please fill in a valid URL.")}
+        if !is_url_wellformed $form->param("url");
+    # Check if this item is duplicated
+    @_ = qw();
+    push @_, "url=" . $DBH->quote($form->param("url"));
+    push @_, "sn!=" . $self->{"sn"} if $self->{"iscur"};
+    $sql = "SELECT * FROM " . $DBH->quote_identifier($self->{"table"})
+        . " WHERE " . join(" AND ", @_) . ";\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    return {"msg"=>N_("This related link already exists.  You cannot create a duplicated one.")}
+        if $sth->rows > 0;
+    # Check if it is available
+    return {"msg"=>N_("This URL is not reachable.  Check if there is any typo in it.")}
+        if  $self->_missing("hid")
+            && !is_url_reachable $form->param("url");
+    # OK
+    return;
+}
+
+return 1;

lib/perl5/Selima/Checker/LinkCat.pm

@@ -0,0 +1,121 @@
+# Selima Website Content Management System
+# LinkCat.pm: The related-link category form checker.
+
+#  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-10-24
+
+package Selima::Checker::LinkCat;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+use Selima::CallForm;
+use Selima::ChkFunc;
+use Selima::DataVars qw($DBH :forms);
+use Selima::ShortCut;
+
+# new: Initialize the checker
+sub new : method {
+    local ($_, %_);
+    my ($class, $self);
+    ($class, @_) = @_;
+    $_[1] = "linkcat" if scalar(@_) < 2 || !defined $_[1];
+    $self = $class->SUPER::new(@_);
+    ${$self->{"maxlens"}}{"ord"} = 2;
+    ${$self->{"minlens"}}{"id"} = 2;
+    return $self;
+}
+
+# _check_id: Check the ID.
+sub _check_id : method {
+    local ($_, %_);
+    my ($self, $form, $error, $sth, $sql);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Run the default ID. checker
+    $error = $self->SUPER::_check_id;
+    return $error if defined $error;
+    # ID. cannot be "index" to avoid overriding index.html
+    return {"msg"=>N_("\"index\" is dedicated to the index file index.html.  You cannot set the ID. as \"index\".")}
+        if $form->param("id") eq "index";
+    # Check if this item is duplicated
+    if (!$self->_missing("topmost", "parent")) {
+        @_ = qw();
+        push @_, "id=" . $DBH->quote($form->param("id"));
+        push @_, "sn!=" . $self->{"sn"} if $self->{"iscur"};
+        if ($form->param("topmost") eq "true") {
+            push @_, "parent IS NULL";
+        } else {
+            push @_, "parent=" . $DBH->quote($form->param("parent"));
+        }
+        $sql = "SELECT * FROM " . $DBH->quote_identifier($self->{"table"})
+            . " WHERE " . join(" AND ", @_) . ";\n";
+        $sth = $DBH->prepare($sql);
+        $sth->execute;
+        return {"msg"=>N_("This category already exists.  You cannot create a duplicated one.")}
+            if $sth->rows > 0;
+    }
+    # OK
+    return;
+}
+
+# _check_parent: Check the parent category
+sub _check_parent : method {
+    local ($_, %_);
+    my ($self, $form, $error, $sth, $sql);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # "topmost not set" has a different form context
+    return {"msg"=>N_("Please select a parent category.")}
+        if $self->_missing("topmost");
+    # Regularize it
+    $self->_trim("topmost");
+    # Check the option value
+    return {"msg"=>N_("This option is invalid.  Please select a proper parent category.")}
+        unless $form->param("topmost") =~ /^(?:true|false)$/;
+    # Check the parent category if not a topmost category
+    if ($form->param("topmost") eq "false") {
+        # Check if it exists
+        $error = $self->_missing("parent");
+        return $error if defined $error;
+        # Regularize it
+        $self->_trim("parent");
+        # Check if it is filled
+        return {"msg"=>N_("Please select a parent category.")}
+            if $form->param("parent") eq "";
+        # Check if this category exists
+        return {"msg"=>N_("This parent category does not exist anymore.  Please select another one.")}
+            if !check_sn_in ${$form->param_fetch("parent")}[0], "linkcat";
+        if ($self->{"iscur"}) {
+            # Check if the parent category is itself
+            return {"msg"=>N_("A category cannot belong to itself.  Please select another one.")}
+                if $form->param("parent") == $self->{"sn"};
+            # Check if the parent directory is its descendant
+            $sql = "SELECT linkcat_ischild(" . $self->{"sn"} . ", "
+                . $form->param("parent") . ") AS is_child;\n";
+            $sth = $DBH->prepare($sql);
+            $sth->execute;
+            return {"msg"=>N_("A category cannot belong to its descendant.  Please select another one.")}
+                if ${$sth->fetchrow_hashref}{"is_child"};
+        }
+    }
+    # OK
+    return;
+}
+
+return 1;

lib/perl5/Selima/Checker/LinkCatz.pm

@@ -0,0 +1,162 @@
+# Selima Website Content Management System
+# LinkCatz.pm: The related-link category membership form checker.
+
+#  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-11-03
+
+package Selima::Checker::LinkCatz;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+use Selima::ChkFunc;
+use Selima::CallForm;
+use Selima::DataVars qw($DBH :forms);
+use Selima::ShortCut;
+
+# new: Initialize the checker
+sub new : method {
+    local ($_, %_);
+    my $class;
+    ($class, @_) = @_;
+    $_[1] = "linkcatz" if scalar(@_) < 2 || !defined $_[1];
+    return $class->SUPER::new(@_);
+}
+
+# check: Run a list of checks
+sub check : method {
+    local ($_, %_);
+    my ($self, $error, @cols);
+    ($self, @cols) = @_;
+    # Run the parent method first
+    $error = $self->SUPER::check(@cols);
+    return $error if defined $error;
+    # See if we need to check the duplicates.  Check it in the end.
+    %_ = map { $_ => 1 } @cols;
+    if (exists $_{"cat"} && exists $_{"link"}) {
+        $error = $self->__check_dup();
+        return $error if defined $error;
+    }
+    return;
+}
+
+# _check_cat: Check the category
+sub _check_cat : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("cat");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("cat");
+    # Check if it is filled
+    return {"msg"=>N_("Please select a category.")}
+        if $form->param("cat") eq "";
+    # Check if the category exists
+    return {"msg"=>N_("This category does not exist anymore.  Please select another one.")}
+        if !check_sn_in ${$form->param_fetch("cat")}[0], "linkcat";
+    # OK
+    return;
+}
+
+# _check_link: Check the related link
+sub _check_link : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("link");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("link");
+    # Check if it is filled
+    return {"msg"=>N_("Please select a related link.")}
+        if $form->param("link") eq "";
+    # Check if this link exists
+    return {"msg"=>N_("This related link does not exist anymore.  Please select another one.")}
+        if !check_sn_in ${$form->param_fetch("link")}[0], "links";
+    # OK
+    return;
+}
+
+# __check_dup: Check if this item is duplicated
+sub __check_dup : method {
+    local ($_, %_);
+    my ($self, $form, $error, $sth, $sql);
+    $self = $_[0];
+    $form = $self->{"form"};
+    @_ = qw();
+    push @_, "cat=" . $form->param("cat");
+    push @_, "link=" . $form->param("link");
+    push @_, "sn!=" . $self->{"sn"}
+        if $self->{"iscur"};
+    $sql = "SELECT * FROM " . $DBH->quote_identifier($self->{"table"})
+        . " WHERE " . join(" AND ", @_) . ";\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    return {"msg"=>N_("This categorization record already exists.  You cannot create a duplicated one.")}
+        if $sth->rows > 0;
+    return;
+}
+
+# _redir_selcat: Suspend and move to the category selection form
+sub _redir_selcat : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Skip if not requested
+    return if $self->_missing("selcat");
+    call_form FORM_LINKCAT, undef, "import_selcat";
+}
+
+# _redir_delcat: Remove the category
+sub _redir_delcat : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Skip if not requested
+    return if $self->_missing("delcat");
+    $self->{"form"}->delete("cat");
+    success_redirect undef;
+}
+
+# _redir_sellink: Suspend and move to the related link selection form
+sub _redir_sellink : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Skip if not requested
+    return if $self->_missing("sellink");
+    call_form FORM_LINKS, undef, "import_sellink";
+}
+
+# _redir_dellink: Remove the related link
+sub _redir_dellink : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Skip if not requested
+    return if $self->_missing("dellink");
+    $self->{"form"}->delete("link");
+    success_redirect undef;
+}
+
+return 1;

lib/perl5/Selima/Checker/ListPref.pm

@@ -0,0 +1,132 @@
+# Selima Website Content Management System
+# ListPref.pm: The list preference form checker.
+
+#  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-10-14
+
+package Selima::Checker::ListPref;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+use Selima::CallForm;
+use Selima::ChkFunc;
+use Selima::DataVars qw($DBH :forms);
+use Selima::HTTP;
+use Selima::ShortCut;
+
+# new: Initialize the checker
+sub new : method {
+    local ($_, %_);
+    my ($class, $self);
+    ($class, @_) = @_;
+    $_[1] = "userpref" if scalar(@_) < 2 || !defined $_[1];
+    $self = $class->SUPER::new(@_);
+    ${$self->{"maxlens"}}{"listsize"} = 4;
+    return $self;
+}
+
+# _check_domain: Check the preference domain
+sub _check_domain : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("domain");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("domain");
+    # Check if it is filled
+    return {"msg"=>N_("Please fill in the preference domain.")}
+        if $form->param("domain") eq "";
+    # Check the length
+    return {"msg"=>N_("This preference domain is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"domain"}]}
+        if length $form->param("domain") > ${$self->{"maxlens"}}{"domain"};
+    # OK
+    return;
+}
+
+# _check_listcols: Check the list columns
+sub _check_listcols : method {
+    local ($_, %_);
+    my ($self, $listcols, $errmsg);
+    $self = $_[0];
+    # No need to check the validility.  Invalids are simply ignored.
+    @_ = grep s/^listcols_//, $self->{"form"}->param;
+    # Obtain the preference value
+    $listcols = join " ", @_;
+    # Skip if it is not filled
+    return if $listcols eq "";
+    # Check the length
+    if (length "listcols" > ${$self->{"maxlens"}}{"name"}) {
+        $errmsg = sprintf "Maximum preference name length too short (%d for \"%s\" %d)",
+            ${$self->{"maxlens"}}{"name"}, "listcols", length "listcols";
+        http_500 $errmsg;
+    }
+    if (length $listcols > ${$self->{"maxlens"}}{"value"}) {
+        $errmsg = sprintf "Maximum preference value length too short (%d for \"%s\" %d)",
+            ${$self->{"maxlens"}}{"name"}, "listcols", length $listcols;
+        http_500 $errmsg;
+    }
+    # OK
+    return;
+}
+
+# _check_listsize: Check the list size
+sub _check_listsize : method {
+    local ($_, %_);
+    my ($self, $form, $error, $errmsg);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("listsize");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("listsize");
+    # Check if it is filled
+    return {"msg"=>N_("Please fill in the number of rows per page.")}
+        if $form->param("listsize") eq "";
+    # If there is any non-digit character
+    return {"msg"=>N_("Please fill in a positive integer number of rows per page.")}
+        unless $form->param("listsize") =~ /^[1-9][0-9]*$/;
+    # Set to an integer
+    $_ = $form->param("listsize");
+    $_ += 0;
+    $form->param("listsize", $_);
+    # Check the length
+    return {"msg"=>N_("This number of rows per page is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"listsize"}]}
+        if length $form->param("listsize") > ${$self->{"maxlens"}}{"listsize"};
+    # Check the length
+    if (length "listsize" > ${$self->{"maxlens"}}{"name"}) {
+        $errmsg = sprintf "Maximum preference name length too short (%d for \"%s\" %d)",
+            ${$self->{"maxlens"}}{"name"}, "listsize", length "listsize";
+        http_500 $errmsg;
+    }
+    if (length $form->param("listsize") > ${$self->{"maxlens"}}{"value"}) {
+        $errmsg = sprintf "Maximum preference value length too short (%d for \"%s\" %d)",
+            ${$self->{"maxlens"}}{"name"}, "listsize", length $form->param("listsize");
+        http_500 $errmsg;
+    }
+    # OK
+    return;
+}
+
+return 1;

lib/perl5/Selima/Checker/LogIn.pm

@@ -0,0 +1,238 @@
+# Selima Website Content Management System
+# LogIn.pm: The log-in form checker.
+
+#  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-26
+
+package Selima::Checker::LogIn;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker::User);
+
+use Digest::MD5 qw(md5_hex);
+
+use Selima::Array;
+use Selima::ChkPriv;
+use Selima::DataVars qw($DBH :hostconf);
+use Selima::Guest;
+use Selima::HTTP;
+use Selima::Logging;
+use Selima::ShortCut;
+
+# new: Initialize the checker
+sub new : method {
+    local ($_, %_);
+    my ($class, $self);
+    ($class, @_) = @_;
+    $_[1] = "users" if scalar(@_) < 2 || !defined $_[1];
+    $self = $class->SUPER::new(@_);
+    $self->{"row"} = undef;
+    $self->{"allcols"} = [ $DBH->cols($self->{"table"}) ];
+    return $self;
+}
+
+# check: Run a list of checks
+sub check : method {
+    local ($_, %_);
+    my ($self, $error, @cols);
+    ($self, @cols) = @_;
+    
+    # See if a log in is attemped.
+    %_ = map { $_ => 1 } @cols;
+    $self->{"login"} = exists $_{"id"} && exists $_{"passwd"}
+        if !exists $self->{"login"};
+    # Run the parent method first
+    $error = $self->SUPER::check(@cols);
+    return $error if defined $error;
+    return;
+}
+
+# _check_id: Check the user ID
+sub _check_id : method {
+    local ($_, %_);
+    my ($self, $form, $error, $sth, $sql);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("id");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("id");
+    # Check if it is filled
+    return {"msg"=>N_("Please fill in your user ID.")}
+        if $form->param("id") eq "";
+    # Check the length
+    if (length $form->param("id") > ${$self->{"maxlens"}}{"id"}) {
+        actlog("Log in failed for user " . $form->param("id")
+                . " because user ID is too long.")
+            if $self->{"login"};
+        return {"msg"=>N_("Log in failed.  Either your user ID or your password is incorrect.")};
+    }
+    if (length $form->param("id") < ${$self->{"minlens"}}{"id"}) {
+        actlog("Log in failed for user " . $form->param("id")
+                . " because user ID is too short.")
+            if $self->{"login"};
+        return {"msg"=>N_("Log in failed.  Either your user ID or your password is incorrect.")};
+    }
+    
+    # Check if this user exists
+    @_ = qw();
+    push @_, "id=" . $DBH->quote($form->param("id"));
+    push @_, "NOT deleted" if in_array("deleted", @{$self->{"allcols"}});
+    $sql = "SELECT * FROM " . $DBH->quote_identifier($self->{"table"})
+        . " WHERE " . join(" AND ", @_) . ";\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    if ($sth->rows != 1) {
+        actlog("Log in failed for user " . $form->param("id")
+                . " because user ID does not exist.")
+            if $self->{"login"};
+        return {"msg"=>N_("Log in failed.  Either your user ID or your password is incorrect.")};
+    }
+    # Save it for further reference
+    $self->{"row"} = $sth->fetchrow_hashref;
+    $self->{"sn"} = ${$self->{"row"}}{"sn"};
+    # Check if log-in is closed
+    if ($NOLOGIN && !is_su $self->{"sn"}) {
+        actlog("Log in failed for user " . $form->param("id")
+                . " because website is temporarily closed.")
+            if $self->{"login"};
+        # This message is duplicated
+        return {};
+    }
+    # Check if this user is disabled
+    if (${$self->{"row"}}{"disabled"}) {
+        actlog("Log in failed for user " . $form->param("id")
+                . " because account is disabled.")
+            if $self->{"login"};
+        return {"msg"=>N_("Your account is disabled.  Contact our system administrator for assistence.")};
+    }
+    # OK
+    return;
+}
+
+# _check_passwd: Check the user password
+sub _check_passwd : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Skip password checks for guests
+    return if exists $self->{"sn"} && is_guest $self->{"sn"};
+    # Check if it exists
+    $error = $self->_missing("passwd");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("passwd");
+    # Check if it is filled
+    return {"msg"=>N_("Please fill in your password.")}
+        if $form->param("passwd") eq "";
+    # Check the length
+    if (length $form->param("passwd") > ${$self->{"maxlens"}}{"passwd"}) {
+        actlog("Log in failed for user " . $form->param("id")
+                . " because password is too long.")
+            if $self->{"login"};
+        return {"msg"=>N_("Log in failed.  Either your user ID or your password is incorrect.")};
+    }
+    if (length $form->param("passwd") < ${$self->{"minlens"}}{"passwd"}) {
+        actlog("Log in failed for user " . $form->param("id")
+                . " because password is too short.")
+            if $self->{"login"};
+        return {"msg"=>N_("Log in failed.  Either your user ID or your password is incorrect.")};
+    }
+    # Check if the password is correct
+    if (    defined $self->{"row"}
+            && md5_hex($form->param("id") . ":magicat:"
+                . $form->param("passwd")) eq ${$self->{"row"}}{"passwd"}) {
+        actlog("Log in failed for user " . $form->param("id")
+                . " because password is incorrect.")
+            if $self->{"login"};
+        return {"msg"=>N_("Log in failed.  Either your user ID or your password is incorrect.")};
+    }
+    # OK
+    return;
+}
+
+# _check_authdig: Check the user credential using HTTP Digest Authentication
+sub _check_authdig : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Skip credential checks for guests
+    return if exists $self->{"sn"} && is_guest $self->{"sn"};
+    # Check if it exists
+    http_500 "Apache::AuthDigest::API \"rd\" not supplied"
+        if !exists $self->{"rd"};
+    http_500 "client response \"response\" not supplied"
+        if !exists $self->{"response"};
+    http_500 "\"id\" did not checked before \"authdig\""
+        if !defined $self->{"row"};
+    # Check if the credential is correct
+    if (    !$self->{"rd"}->compare_digest_response($self->{"response"},
+                ${$self->{"row"}}{"passwd"})) {
+        actlog("Log in failed for user " . $form->param("id")
+                . " because password is incorrect.")
+            if $self->{"login"};
+        return {"msg"=>N_("Log in failed.  Either your user ID or your password is incorrect.")};
+    }
+    # OK
+    return;
+}
+
+# _check_admin: Check if the user is an administrator
+sub _check_admin : method {
+    local ($_, %_);
+    my ($self, $form);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Skip checking for guests
+    return if is_guest $self->{"sn"};
+    # Skip checking for super users
+    return if is_su $self->{"sn"};
+    # Check if this user is an administrator
+    if (!is_admin $self->{"sn"}) {
+        actlog("Log in failed for user " . $form->param("id")
+                . " because user is not an administrator.")
+            if $self->{"login"};
+        return {"msg"=>N_("You are not an administrator and cannot log into here.")};
+    }
+    # OK
+    return;
+}
+
+# _check_nonadmin: Check if the user is not an administrator
+sub _check_nonadmin : method {
+    local ($_, %_);
+    my ($self, $form);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Skip checking for guests
+    return if is_guest $self->{"sn"};
+    # Check if this user is an administrator
+    if (is_admin $self->{"sn"}) {
+        actlog("Log in failed for user " . $form->param("id")
+                . " because user is an administrator.")
+            if $self->{"login"};
+        return {"msg"=>N_("You are an administrator and cannot log into here.")};
+    }
+    # OK
+    return;
+}
+
+return 1;

lib/perl5/Selima/Checker/MailTo.pm

@@ -0,0 +1,58 @@
+# Selima Website Content Management System
+# MailTo.pm: The e-mail hyperlink redirection form checker.
+
+#  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-10-25
+
+package Selima::Checker::MailTo;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+use Email::Valid qw();
+
+use Selima::ShortCut;
+
+# _check_email: Check the submitted e-mail
+sub _check_email : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("email");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("email");
+    # Check if it is filled
+    return {"msg"=>N_("Please fill in the e-mail.")}
+        if $form->param("email") eq "";
+    # Un-mung e-mail to its original format
+    $_ = $form->param("email");
+    s/ at /\@/;
+    $form->param("email", $_);
+    # Check the e-mail validity
+    return {"msg"=>N_("Please fill in a valid e-mail address.")}
+        if !Email::Valid->rfc822($form->param("email"));
+    return {"msg"=>N_("The domain of this e-mail does not exists.  Check if there is any typo in it.")}
+        if !Email::Valid->mx($form->param("email"));
+    # OK
+    return;
+}
+
+return 1;

lib/perl5/Selima/Checker/Page.pm

@@ -0,0 +1,52 @@
+# Selima Website Content Management System
+# Page.pm: The base web page form checker.
+
+#  Copyright (c) 2005-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: 2005-02-28
+
+package Selima::Checker::Page;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+# new: Initialize the checker
+sub new : method {
+    local ($_, %_);
+    my ($class, $self);
+    ($class, @_) = @_;
+    $_[1] = "pages" if scalar(@_) < 2 || !defined $_[1];
+    $self = $class->SUPER::new(@_);
+    return $self;
+}
+
+# _check_path: Check the page path
+# Use the default page path checker
+
+# _check_ord: Check the order
+# Use the default order checker
+
+# _check_title: Check the title
+# Use the default title checker
+
+# _check_body: Check the content
+# Use the default content checker
+
+# _check_kw: Check the keywords list
+# Use the default keywords list checker
+
+return 1;

lib/perl5/Selima/Checker/Rebuild.pm

@@ -0,0 +1,51 @@
+# Selima Website Content Management System
+# Rebuild.pm: The web page rebuild form checker.
+
+#  Copyright (c) 2006-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: 2006-04-04
+
+package Selima::Checker::Rebuild;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+use Selima::DataVars qw(:scptconf);
+use Selima::ShortCut;
+
+# _check_type: Check the page type
+sub _check_type : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("type");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("addr");
+    # Check if it is filled
+    return {"msg"=>N_("Please select the type.")}
+        if $form->param("type") eq "";
+    # Check if this link exists
+    return {"msg"=>N_("This type does not exist anymore.  Please select another one.")}
+        unless defined $MAIN->can("rebuild_" .  $form->param("type"));
+    # OK
+    return;
+}
+
+return 1;

lib/perl5/Selima/Checker/ScptPriv.pm

@@ -0,0 +1,82 @@
+# Selima Website Content Management System
+# ScptPriv.pm: The script privilege form checker.
+
+#  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-10-14
+
+package Selima::Checker::ScptPriv;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+use Selima::DataVars qw($DBH);
+use Selima::ShortCut;
+
+# new: Initialize the checker
+sub new : method {
+    local ($_, %_);
+    my $class;
+    ($class, @_) = @_;
+    $_[1] = "scptpriv" if scalar(@_) < 2 || !defined $_[1];
+    return $class->SUPER::new(@_);
+}
+
+# check: Run a list of checks
+sub check : method {
+    local ($_, %_);
+    my ($self, $error, @cols);
+    ($self, @cols) = @_;
+    # Run the parent method first
+    $error = $self->SUPER::check(@cols);
+    return $error if defined $error;
+    # See if we need to check the duplicates.  Check it in the end.
+    %_ = map { $_ => 1 } @cols;
+    if (exists $_{"grp"} && exists $_{"member"}) {
+        $error = $self->__check_dup();
+        return $error if defined $error;
+    }
+    return;
+}
+
+# _check_script: Check the script
+# Use the default script checker
+
+# _check_grp: Check the group
+# Use the default group checker
+
+# __check_dup: Check if this item is duplicated
+sub __check_dup : method {
+    local ($_, %_);
+    my ($self, $form, $error, $sth, $sql);
+    $self = $_[0];
+    $form = $self->{"form"};
+    @_ = qw();
+    push @_, "script=" . $form->param("script");
+    push @_, "grp=" . $form->param("grp");
+    push @_, "sn!=" . $self->{"sn"}
+        if $self->{"iscur"};
+    $sql = "SELECT * FROM " . $DBH->quote_identifier($self->{"table"})
+        . " WHERE " . join(" AND ", @_) . ";\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    return {"msg"=>N_("This script privilege record already exists.  You cannot create a duplicated one.")}
+        if $sth->rows > 0;
+    return;
+}
+
+return 1;

lib/perl5/Selima/Checker/User.pm

@@ -0,0 +1,296 @@
+# Selima Website Content Management System
+# User.pm: The user account form checker.
+
+#  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-26
+
+package Selima::Checker::User;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+use Crypt::Cracklib qw(fascist_check);
+use Email::Valid qw();
+$Crypt::Cracklib::DICT = "/usr/share/dict/pw_dict";
+
+use Selima::Array;
+use Selima::ChkPriv;
+use Selima::DataVars qw($DBH :groups);
+use Selima::LogIn;
+use Selima::UserName;
+use Selima::Passwd;
+use Selima::ShortCut;
+
+use Selima::Checker::UserMem;
+
+# new: Initialize the checker
+sub new : method {
+    local ($_, %_);
+    my ($class, $self);
+    ($class, @_) = @_;
+    $_[1] = "users" if scalar(@_) < 2 || !defined $_[1];
+    $self = $class->SUPER::new(@_);
+    ${$self->{"maxlens"}}{"passwd"} = 16;
+    ${$self->{"minlens"}}{"passwd"} = 6;
+    ${$self->{"minlens"}}{"email"} = 5;
+    return $self;
+}
+
+# check: Run a list of checks
+sub check : method {
+    local ($_, %_);
+    my ($self, @cols, $error);
+    ($self, @cols) = @_;
+    # Check the guest flag first
+    $self->_is_guest;
+    # Run the parent method
+    return $self->SUPER::check(@cols);
+}
+
+# _is_guest: If the user being edited is a guest
+sub _is_guest : method {
+    local ($_, %_);
+    my ($self, $form);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Checked before
+    return $form->param("_is_guest") if !$self->_missing("_is_guest");
+    %_ = map { $_ => 1 } $form->param;
+    for ($_ = 0; exists $_{"supgroup$_" . "sn"}; $_++) {
+        # Skip unselected groups
+        next if !exists $_{"supgroup$_"};
+        # Check if this is the guest group
+        return $form->param("_is_guest", 1)
+            if groupid($form->param("supgroup$_" . "sn")) eq GUEST_GROUP;
+    }
+    # No guest group was found
+    return $form->param("_is_guest", 0);
+}
+
+# _check_id: Check the user ID.
+sub _check_id : method {
+    local ($_, %_);
+    my ($self, $form, $error, $sth, $sql);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Skip for a non-super-user editing a super-user
+    return if $self->{"iscur"} && !is_su && is_su $self->{"sn"};
+    # Check if it exists
+    $error = $self->_missing("id");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("id");
+    # Check if it is filled
+    return {"msg"=>N_("Please fill in the user ID.")}
+        if $form->param("id") eq "";
+    # Check the length
+    return {"msg"=>N_("This user ID. is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"id"}]}
+        if length $form->param("id") > ${$self->{"maxlens"}}{"id"};
+    return {"msg"=>N_("This user ID. is too short.  (Min. length [#,_1])"),
+            "margs"=>[${$self->{"minlens"}}{"id"}]}
+        if length $form->param("id") < ${$self->{"minlens"}}{"id"};
+    # Check if the characters used are valid
+    return {"msg"=>N_("Only English letters, numbers, at-signs, dots, dashes and underscores are allowed for the user ID.")}
+        unless $form->param("id") =~ /^[a-z][a-z0-9@\.\-_]*$/;
+    # Check if this item is duplicated
+    @_ = qw();
+    push @_, "id=" . $DBH->quote($form->param("id"));
+    push @_, "sn!=" . $self->{"sn"} if $self->{"iscur"};
+    $sql = "SELECT * FROM " . $DBH->quote_identifier($self->{"table"})
+        . " WHERE " . join(" AND ", @_) . ";\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    return {"msg"=>N_("This user already has an account.  You cannot create a duplicated one.")}
+        if $sth->rows > 0;
+    # OK
+    return;
+}
+
+# _check_passwd: Check the user password
+sub _check_passwd : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Skip for a non-super-user editing a super-user
+    return if $self->{"iscur"} && !is_su && is_su $self->{"sn"};
+    # Set the passwords with the password registry
+    sync_saved_passwd($form, "*" x ${$self->{"maxlens"}}{"passwd"});
+    # Skip password checking for guests
+    return if $self->_is_guest;
+    # Check if it exists
+    $error = $self->_missing("passwd", "passwd2");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("passwd", "passwd2");
+    # Check if it is filled
+    return {"msg"=>N_("Please fill in the password.")}
+        if !$self->{"iscur"} && $form->param("passwd") eq "";
+    return {"msg"=>N_("Please confirm the password.")}
+        if $form->param("passwd") ne "" && $form->param("passwd2") eq "";
+    # Check the length
+    return {"msg"=>N_("This password is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"passwd"}]}
+        if length $form->param("passwd") > ${$self->{"maxlens"}}{"passwd"};
+    return {"msg"=>N_("This password is too short.  (Min. length [#,_1])"),
+            "margs"=>[${$self->{"minlens"}}{"passwd"}]}
+        if  $form->param("passwd") ne ""
+            && length $form->param("passwd") < ${$self->{"minlens"}}{"passwd"};
+    # Check if two passwords are consistent
+    return {"msg"=>N_("The 2 passwords are different.  Please fill in the password again.")}
+        if $form->param("passwd") ne $form->param("passwd2");
+    if ($form->param("passwd") ne "") {
+        # Check the password strength with cracklib
+        if (($_ = fascist_check($form->param("passwd"))) ne "ok") {
+            # See the message from cracklib/fscist.c
+            # FascistGecos()
+            #return {"msg"=>N_("You are not registered.")}
+            #    if $_ eq "you are not registered in the password file";
+            return {"msg"=>N_("This password is based on the user ID.")}
+                if $_ eq "it is based on your username";
+            #return {"msg"=>N_("This password is based upon the personal information.")}
+            #    if $_ eq "it is based upon your password entry";
+            #return {"msg"=>N_("This password is derived from the personal information.")}
+            #    if  $_ eq "it is derived from your password entry"
+            #        || $_ eq "it's derived from your password entry";
+            #return {"msg"=>N_("This password is derivable from the personal information.")}
+            #    if  $_ eq "it is derivable from your password entry"
+            #        || $_ eq "it's derivable from your password entry";
+            # FascistLook()
+            #return {"msg"=>N_("This password is too short.  (Min. length [#,_1])"),
+            #        "margs"=>[${$self->{"minlens"}}{"passwd"}]}
+            #    if  $_ eq "it's WAY too short"
+            #        || $_ eq "it is too short";
+            return {"msg"=>N_("This password does not contain enough different characters.")}
+                if $_ eq "it does not contain enough DIFFERENT characters";
+            #return {"msg"=>N_("This password is all whitespace.")}
+            #    if $_ eq "it is all whitespace";
+            return {"msg"=>N_("This password is too simplistic/systematic.")}
+                if $_ eq "it is too simplistic/systematic";
+            #return {"msg"=>N_("This password looks like a National Insurance number.")}
+            #    if $_ eq "it looks like a National Insurance number";
+            return {"msg"=>N_("This password is based on a dictionary word.")}
+                if $_ eq "it is based on a dictionary word";
+            return {"msg"=>N_("This password is based on a (reversed) dictionary word.")}
+                if $_ eq "it is based on a (reversed) dictionary word";
+            return {"msg"=>N_("This password is too simple.")};
+        }
+        return {"msg"=>$_}
+            if ($_ = fascist_check($form->param("passwd"))) ne "ok";
+        # Check if the group and the member are different
+        return {"msg"=>N_("You cannot use a password that is based on your user ID.")}
+            if  defined($_ = $form->param("id"))
+                && $form->param("passwd") =~ /$_/i;
+    }
+    # OK
+    return;
+}
+
+# _check_name: Check the user name
+sub _check_name : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("name");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("name");
+    # Check if it is filled
+    return {"msg"=>N_("Please fill in the name.")}
+        if $form->param("name") eq "";
+    # Check the length
+    return {"msg"=>N_("This name is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"name"}]}
+        if length $form->param("name") > ${$self->{"maxlens"}}{"name"};
+    # OK
+    return;
+}
+
+# _check_email: Check the user e-mail
+sub _check_email : method {
+    local ($_, %_);
+    my ($self, $form, $error, $col);
+    ($self, $col) = @_;
+    $form = $self->{"form"};
+    $col = "email" if !defined $col;
+    # Check if it exists
+    $error = $self->_missing($col);
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim($col);
+    # Check if it is filled
+    return {"msg"=>N_("Please fill in the e-mail.")}
+        if $form->param($col) eq "";
+    # Check the length
+    return {"msg"=>N_("This e-mail is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{$col}]}
+        if length $form->param($col) > ${$self->{"maxlens"}}{$col};
+    return {"msg"=>N_("This e-mail is too short.  (Min. length [#,_1])"),
+            "margs"=>[${$self->{"minlens"}}{$col}]}
+        if length $form->param($col) < ${$self->{"minlens"}}{$col};
+    # Check the e-mail validity
+    return {"msg"=>N_("Please fill in a valid e-mail address.")}
+        if !Email::Valid->rfc822($form->param($col));
+    return {"msg"=>N_("The domain of this e-mail does not exists.  Check if there is any typo in it.")}
+        if !Email::Valid->mx($form->param($col));
+    # OK
+    return;
+}
+
+# _check_supgroup: Check the belonging groups
+sub _check_supgroup : method {
+    local ($_, %_);
+    my ($self, $form, $error, %items);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Skip for a non-super-user editing herself
+    return if $self->{"iscur"} && !is_su && $self->{"sn"} == get_login_sn;
+    for (my $i = 0, %items = qw(); !$self->_missing("supgroup$i" . "sn"); $i++) {
+        my ($subform, $checker);
+        # Skip unselected ones
+        next if $self->_missing("supgroup$i");
+        # Regularize it
+        $self->_trim("supgroup$i" . "sn");
+        # Check if this selection is duplicated
+        return {"msg"=>N_("This belonging group is duplicated.  You cannot set duplicated ones.")}
+            if exists $items{$form->param("supgroup$i" . "sn")};
+        $items{$form->param("supgroup$i" . "sn")} = 1;
+        # Check with the subform checker
+        $subform = new CGI("");
+        $subform->param("grp", $form->param("supgroup$i" . "sn"));
+        $subform->param("member", $self->{"sn"}) if $self->{"iscur"};
+        $checker = new Selima::Checker::UserMem($subform);
+        $error = $checker->check("grp");
+        return $error if defined $error;
+        # Check if a special group is submitted
+        $_ = groupid($form->param("supgroup$i" . "sn"));
+        return {"msg"=>N_("You cannot submit the super-user group along with other groups.")}
+            if $_ eq SU_GROUP;
+        return {"msg"=>N_("You cannot set the administrators group.")}
+            if $_ eq ADMIN_GROUP;
+        return {"msg"=>N_("You cannot set the all-users group.")}
+            if $_ eq ALLUSERS_GROUP;
+    }
+    # OK
+    return;
+}
+
+return 1;

lib/perl5/Selima/Checker/UserMem.pm

@@ -0,0 +1,123 @@
+# Selima Website Content Management System
+# UserMem.pm: The user-to-group membership form checker.
+
+#  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-10-10
+
+package Selima::Checker::UserMem;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+use Selima::ChkFunc;
+use Selima::CallForm;
+use Selima::DataVars qw($DBH :forms);
+use Selima::ShortCut;
+
+# new: Initialize the checker
+sub new : method {
+    local ($_, %_);
+    my $class;
+    ($class, @_) = @_;
+    $_[1] = "usermem" if scalar(@_) < 2 || !defined $_[1];
+    return $class->SUPER::new(@_);
+}
+
+# check: Run a list of checks
+sub check : method {
+    local ($_, %_);
+    my ($self, $error, @cols);
+    ($self, @cols) = @_;
+    # Run the parent method first
+    $error = $self->SUPER::check(@cols);
+    return $error if defined $error;
+    # See if we need to check the duplicates.  Check it in the end.
+    %_ = map { $_ => 1 } @cols;
+    if (exists $_{"grp"} && exists $_{"member"}) {
+        $error = $self->__check_dup();
+        return $error if defined $error;
+    }
+    return;
+}
+
+# _check_grp: Check the group
+# Use the default group checker
+
+# _check_member: Check the member
+sub _check_member : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("member");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("member");
+    # Check if it is filled
+    return {"msg"=>N_("Please select a member.")}
+        if $form->param("member") eq "";
+    # Check if this user exists
+    return {"msg"=>N_("This member does not exist anymore.  Please select another one.")}
+        if !check_sn_in ${$form->param_fetch("member")}[0], "users AS usrmembers";
+    # OK
+    return;
+}
+
+# __check_dup: Check if this item is duplicated
+sub __check_dup : method {
+    local ($_, %_);
+    my ($self, $form, $error, $sth, $sql);
+    $self = $_[0];
+    $form = $self->{"form"};
+    @_ = qw();
+    push @_, "grp=" . $form->param("grp");
+    push @_, "member=" . $form->param("member");
+    push @_, "sn!=" . $self->{"sn"}
+        if $self->{"iscur"};
+    $sql = "SELECT * FROM " . $DBH->quote_identifier($self->{"table"})
+        . " WHERE " . join(" AND ", @_) . ";\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    return {"msg"=>N_("This membership record already exists.  You cannot create a duplicated one.")}
+        if $sth->rows > 0;
+    return;
+}
+
+# _redir_selmember: Suspend and move to the member selection form
+sub _redir_selmember : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Skip if not requested
+    return if $self->_missing("selmember");
+    call_form FORM_USERS, undef, "import_selmember";
+}
+
+# _redir_delmember: Remove the member
+sub _redir_delmember : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Skip if not requested
+    return if $self->_missing("delmember");
+    $self->{"form"}->delete("member");
+    success_redirect undef;
+}
+
+return 1;

lib/perl5/Selima/Checker/UserPref.pm

@@ -0,0 +1,207 @@
+# Selima Website Content Management System
+# UserPref.pm: The user preference form checker.
+
+#  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-10-14
+
+package Selima::Checker::UserPref;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+use Selima::CallForm;
+use Selima::DataVars qw($DBH :forms);
+use Selima::ShortCut;
+
+# new: Initialize the checker
+sub new : method {
+    local ($_, %_);
+    my $class;
+    ($class, @_) = @_;
+    $_[1] = "userpref" if scalar(@_) < 2 || !defined $_[1];
+    return $class->SUPER::new(@_);
+}
+
+# check: Run a list of checks
+sub check : method {
+    local ($_, %_);
+    my ($self, $error, @cols);
+    ($self, @cols) = @_;
+    # Run the parent method first
+    $error = $self->SUPER::check(@cols);
+    return $error if defined $error;
+    # See if we need to check the duplicates.  Check it in the end.
+    %_ = map { $_ => 1 } @cols;
+    if (exists $_{"usr"} && exists $_{"domain"} && exists $_{"name"}) {
+        $error = $self->__check_dup();
+        return $error if defined $error;
+    }
+    return;
+}
+
+# _check_usr: Check the user
+sub _check_usr : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # "everyone not set" has a different form context
+    return {"msg"=>N_("Please select the user.")}
+        if $self->_missing("everyone");
+    # Regularize it
+    $self->_trim("everyone");
+    # Check the option value
+    return {"msg"=>N_("This option is invalid.  Please select a proper user.")}
+        unless $form->param("everyone") =~ /^(?:true|false)$/;
+    # Check the user if not everyone
+    if ($form->param("everyone") eq "false") {
+        $error = $self->SUPER::_check_usr;
+        return $error if defined $error;
+    }
+    # OK
+    return;
+}
+
+# _check_domain: Check the domain
+sub _check_domain : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # "everywhere not set" has a different form context
+    return {"msg"=>N_("Please set the preference domain.")}
+        if $self->_missing("everywhere");
+    # Regularize it
+    $self->_trim("everywhere");
+    # Check the option value
+    return {"msg"=>N_("This option is invalid.  Please set a proper preference domain.")}
+        unless $form->param("everywhere") =~ /^(?:true|false)$/;
+    # Check the domain if not everywhere
+    if ($form->param("everywhere") eq "false") {
+        # Check if it exists
+        $error = $self->_missing("domain");
+        return $error if defined $error;
+        # Regularize it
+        $self->_trim("domain");
+        # Check if it is filled
+        return {"msg"=>N_("Please fill in the preference domain.")}
+            if $form->param("domain") eq "";
+        # Check the length
+        return {"msg"=>N_("This preference domain is too long.  (Max. length [#,_1])"),
+                "margs"=>[${$self->{"maxlens"}}{"domain"}]}
+            if length $form->param("domain") > ${$self->{"maxlens"}}{"domain"};
+    }
+    # OK
+    return;
+}
+
+# _check_name: Check the preference name
+sub _check_name : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("name");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("name");
+    # Check if it is filled
+    return {"msg"=>N_("Please fill in the preference name.")}
+        if $form->param("name") eq "";
+    # Check the length
+    return {"msg"=>N_("This preference name is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"name"}]}
+        if length $form->param("name") > ${$self->{"maxlens"}}{"name"};
+    # OK
+    return;
+}
+
+# _check_value: Check the preference value
+sub _check_value : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("value");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("value");
+    # Check if it is filled
+    return {"msg"=>N_("Please fill in the preference value.")}
+        if $form->param("value") eq "";
+    # Check the length
+    return {"msg"=>N_("This preference value is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"value"}]}
+        if length $form->param("value") > ${$self->{"maxlens"}}{"value"};
+    # OK
+    return;
+}
+
+# __check_dup: Check if this item is duplicated
+sub __check_dup : method {
+    local ($_, %_);
+    my ($self, $form, $error, $sth, $sql);
+    $self = $_[0];
+    $form = $self->{"form"};
+    @_ = qw();
+    if ($form->param("everyone") eq "true") {
+        push @_, "usr IS NULL";
+    } else {
+        push @_, "usr=" . $form->param("usr");
+    }
+    if ($form->param("everywhere") eq "true") {
+        push @_, "domain IS NULL";
+    } else {
+        push @_, "domain=" . $DBH->quote($form->param("domain"));
+    }
+    push @_, "name=" . $DBH->quote($form->param("name"));
+    push @_, "sn!=" . $self->{"sn"}
+        if $self->{"iscur"};
+    $sql = "SELECT * FROM " . $DBH->quote_identifier($self->{"table"})
+        . " WHERE " . join(" AND ", @_) . ";\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    return {"msg"=>N_("This user preference already exists.  You cannot create a duplicated one.")}
+        if $sth->rows > 0;
+    return;
+}
+
+# _redir_selusr: Suspend and move to the user selection form
+sub _redir_selusr : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Skip if not requested
+    return if $self->_missing("selusr");
+    call_form FORM_USERS, undef, "import_selusr";
+}
+
+# _redir_delusr: Remove the user
+sub _redir_delusr : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Skip if not requested
+    return if $self->_missing("delusr");
+    $self->{"form"}->delete("usr");
+    success_redirect undef;
+}
+
+return 1;