Initial commit.

lib/perl5/Selima/Processor/AcctRec.pm

@@ -0,0 +1,134 @@
+# Selima Website Content Management System
+# AcctRec.pm: The accounting record data processor.
+
+#  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-23
+
+package Selima::Processor::AcctRec;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor);
+
+use Selima::Accounting;
+use Selima::DataVars qw(:addcol);
+use Selima::Guest;
+use Selima::ShortCut;
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "acctrecs" if @_ < 2;
+    $self = $class->SUPER::new(@_);
+    return $self;
+}
+
+# _save_cols: Save the column deposit
+sub _save_cols : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    if ($self->{"type"} ne "del") {
+        # Set the debit/credit status
+        if (defined $form->param("type")) {
+            if ($form->param("type") eq "credit") {
+                $form->param("credit", 1);
+            } elsif ($form->param("type") eq "debit") {
+                $form->delete("credit");
+            }
+        }
+    }
+    # A form to create a new item
+    if ($self->{"type"} eq "new") {
+        $self->{"sn"} = $self->_new_sn;
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_INSERT);
+        $self->{"cols"}->addnum("sn", $self->{"sn"});
+        $self->{"cols"}->addnum("trx", $self->_form("trx"));
+        $self->{"cols"}->addbool("credit", $self->_form("credit"));
+        $self->{"cols"}->addnum("ord", $self->_form("ord"));
+        $self->{"cols"}->addnum("subj", $self->_form("subj"));
+        $self->{"cols"}->addstr("summary", $self->_form("summary"));
+        $self->{"cols"}->addnum("amount", $self->_form("amount"));
+    
+    # A form to edit a current item
+    } elsif ($self->{"type"} eq "cur") {
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
+        $self->{"cols"}->addnum("trx", $self->_form("trx"), scalar $cur->param("trx"));
+        $self->{"cols"}->addbool("credit", $self->_form("credit"), scalar $cur->param("credit"));
+        $self->{"cols"}->addnum("ord", $self->_form("ord"), scalar $cur->param("ord"));
+        $self->{"cols"}->addnum("subj", $self->_form("subj"), scalar $cur->param("subj"));
+        $self->{"cols"}->addstr("summary", $self->_form("summary"), scalar $cur->param("summary"));
+        $self->{"cols"}->addnum("amount", $self->_form("amount"), scalar $cur->param("amount"));
+    }
+    return;
+}
+
+# _actlog: Log the activity
+sub _actlog : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    return gactlog "Create an accounting record "
+            . (defined $form->param("credit")? "credit": "debit")
+            . " number " . $form->param("ord")
+            . " of transaction " . accttrx_id($form->param("trx"))
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return gactlog "Update the accounting record "
+            . (defined $form->param("credit")? "credit": "debit")
+            . " number " . $form->param("ord")
+            . " of transaction " . accttrx_id($form->param("trx"))
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return gactlog "Delete the accounting record "
+            . ($cur->param("credit")? "credit": "debit")
+            . " number " . $cur->param("ord")
+            . " of transaction " . accttrx_id($cur->param("trx"))
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "del";
+}
+
+# _ret_status: Return the process status
+sub _ret_status : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    return {"msg"=>N_("This accounting record was not modified."),
+            "isform"=>0}
+        if !$self->_modified;
+    # A form to create a new item
+    return {"msg"=>N_("This accounting record has been successfully added."),
+            "isform"=>0}
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return {"msg"=>N_("This accounting record has been successfully updated."),
+            "isform"=>0}
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return {"msg"=>N_("This accounting record has been successfully deleted."),
+            "isform"=>0}
+        if $self->{"type"} eq "del";
+}
+
+return 1;

lib/perl5/Selima/Processor/AcctSubj.pm

@@ -0,0 +1,117 @@
+# Selima Website Content Management System
+# AcctSubj.pm: The accounting subject data processor.
+
+#  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::Processor::AcctSubj;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor);
+
+use Selima::DataVars qw(:addcol);
+use Selima::Guest;
+use Selima::ShortCut;
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "acctsubj" if @_ < 2;
+    $self = $class->SUPER::new(@_);
+    return $self;
+}
+
+# _save_cols: Save the column deposit
+sub _save_cols : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    if ($self->{"type"} ne "del") {
+        # Set the "topmost" parent
+        $form->delete("parent") if  defined $form->param("topmost")
+                                    && $form->param("topmost") eq "true";
+    }
+    # A form to create a new item
+    if ($self->{"type"} eq "new") {
+        $self->{"sn"} = $self->_new_sn;
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_INSERT);
+        $self->{"cols"}->addnum("sn", $self->{"sn"});
+        $self->{"cols"}->addnum("parent", $self->_form("parent"));
+        $self->{"cols"}->addstr("code", $self->_form("code"));
+        $self->{"cols"}->addstr("title", $self->_form("title"));
+        # Automatic Traditional Chinese to Simplified Chinese conversion
+        $self->_zhsync;
+    
+    # A form to edit a current item
+    } elsif ($self->{"type"} eq "cur") {
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
+        $self->{"cols"}->addnum("parent", $self->_form("parent"), scalar $cur->param("parent"));
+        $self->{"cols"}->addstr("code", $self->_form("code"), scalar $cur->param("code"));
+        $self->{"cols"}->addstr("title", $self->_form("title"), scalar $cur->param("title"));
+        # Automatic Traditional Chinese to Simplified Chinese conversion
+        $self->_zhsync;
+    }
+    return;
+}
+
+# _actlog: Log the activity
+sub _actlog : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    return gactlog "Create an accounting subject of code " . $form->param("code")
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return gactlog "Update the accounting subject of code " . $form->param("code")
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return gactlog "Delete the accounting subject of code " . $cur->param("code")
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "del";
+}
+
+# _ret_status: Return the process status
+sub _ret_status : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    return {"msg"=>N_("This accounting subject was not modified."),
+            "isform"=>0}
+        if !$self->_modified;
+    # A form to create a new item
+    return {"msg"=>N_("This accounting subject has been successfully added."),
+            "isform"=>0}
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return {"msg"=>N_("This accounting subject has been successfully updated."),
+            "isform"=>0}
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return {"msg"=>N_("This accounting subject has been successfully deleted."),
+            "isform"=>0}
+        if $self->{"type"} eq "del";
+}
+
+return 1;

lib/perl5/Selima/Processor/AcctTrx.pm

@@ -0,0 +1,449 @@
+# Selima Website Content Management System
+# AcctTrx.pm: The accounting transaction data processor.
+
+#  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-23
+
+package Selima::Processor::AcctTrx;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor);
+
+use Selima::Accounting;
+use Selima::DataVars qw($DBH :addcol :dataman);
+use Selima::Format;
+use Selima::Guest;
+use Selima::ShortCut;
+
+use Selima::Processor::AcctRec;
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "accttrx" if @_ < 2;
+    $self = $class->SUPER::new(@_);
+    $self->{"fix_ord"} = 1;
+    $self->{"subtype"} = $self->{"form"}->param("formsub");
+    return $self;
+}
+
+# _save_cols: Save the column deposit
+sub _save_cols : method {
+    local ($_, %_);
+    my ($self, $form, $cur, $o, $sum, $myord);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    
+    if ($self->{"type"} ne "del") {
+        # Supply the omitting debit/credit record
+        # A form to fill in a cash expense transaction
+        if ($self->{"subtype"} eq "expense") {
+            $sum = 0;
+            foreach (grep /^debt\d+amount$/, $form->param) {
+                $sum += $form->param($_) if $form->param($_) =~ /^\d+$/
+            }
+            $form->delete($_)
+                foreach grep /^crdt\d+/, $form->param;
+            $form->param("crdt0subj", acctsubj_sn(ACCTSUBJ_CASH));
+            $form->param("crdt0summary", undef);
+            $form->param("crdt0amount", $sum);
+            if (    $self->{"type"} eq "cur"
+                    && $cur->param("crdtcount") == 1
+                    && $cur->param("crdt0subj") == acctsubj_sn(ACCTSUBJ_CASH)) {
+                $form->param("crdt0summary", $cur->param("crdt0summary"));
+            }
+        # A form to fill in a cash income transaction
+        } elsif ($self->{"subtype"} eq "income") {
+            $sum = 0;
+            foreach (grep /^crdt\d+amount$/, $form->param) {
+                $sum += $form->param($_) if $form->param($_) =~ /^\d+$/
+            }
+            $form->delete($_)
+                foreach grep /^debt\d+/, $form->param;
+            $form->param("debt0subj", acctsubj_sn(ACCTSUBJ_CASH));
+            $form->param("debt0summary", undef);
+            $form->param("debt0amount", $sum);
+            if (    $self->{"type"} eq "cur"
+                    && $cur->param("debtcount") == 1
+                    && $cur->param("debt0subj") == acctsubj_sn(ACCTSUBJ_CASH)) {
+                $form->param("debt0summary", $cur->param("debt0summary"));
+            }
+        }
+    }
+    
+    # A form to create a new item
+    if ($self->{"type"} eq "new") {
+        # Shrink to the maximum order
+        $myord = $form->param("ord");
+        $myord = accttrx_maxord $form->param("date")
+            if $self->{"fix_ord"} && $myord > accttrx_maxord $form->param("date");
+        $self->{"myord"} = $myord;
+        $self->{"sn"} = $self->_new_sn;
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_INSERT);
+        $self->{"cols"}->addnum("sn", $self->{"sn"});
+        $self->{"cols"}->adddate("date", $self->_form("date"));
+        $self->{"cols"}->addnum("ord", $myord);
+        $self->{"cols"}->addstr("note", $self->_form("note"));
+        
+        # Fix the order of other records
+        if ($self->{"fix_ord"}) {
+            my ($sql, $sth, $count, $row);
+            $sql = "SELECT * FROM " . $self->{"table"}
+                . " WHERE date=" . $DBH->quote($form->param("date"))
+                . " ORDER BY ord;\n";
+            $sth = $DBH->prepare($sql);
+            $sth->execute;
+            $count = $sth->rows;
+            for ($_ = 0, $o = 1; $_ < $count; $_++, $o++) {
+                my ($subform, $cols, %CURRENT_SUP);
+                $row = $sth->fetchrow_hashref;
+                $o++ if $o == $myord;
+                next if $$row{"ord"} == $o;
+                %CURRENT_SUP = %CURRENT;
+                %CURRENT = (%$row);
+                $subform = new CGI({%CURRENT});
+                $subform->param("form", "cur");
+                $subform->param("formsub", "trans");
+                $subform->param("ord", $o);
+                $subform->param("date", fmtdate($CURRENT{"date"}));
+                $cols = new Selima::Processor::AcctTrx($subform);
+                $cols->{"fix_ord"} = 0;
+                $cols->_save_cols;
+                unshift @{$self->{"pres"}}, $cols;
+                %CURRENT = %CURRENT_SUP;
+            }
+        }
+        
+        # Find the changed items
+        if ($self->{"fix_ord"}) {
+            for ($_ = 0, $o = 1; defined $form->param("debt$_" . "subj"); $_++) {
+                my ($subform, $cols);
+                # Not selected
+                next unless $form->param("debt$_" . "subj") ne "";
+                $subform = new CGI("");
+                $subform->param("form", "new");
+                $subform->param("trx", $self->{"sn"});
+                $subform->delete("credit");
+                $subform->param("ord", $o++);
+                $subform->param("subj", $form->param("debt$_" . "subj"));
+                $subform->param("summary", $form->param("debt$_" . "summary"));
+                $subform->param("amount", $form->param("debt$_" . "amount"));
+                $cols = new Selima::Processor::AcctRec($subform);
+                $cols->_save_cols;
+                push @{$self->{"subs"}}, $cols;
+            }
+            
+            for ($_ = 0, $o = 1; defined $form->param("crdt$_" . "subj"); $_++) {
+                my ($subform, $cols);
+                # Not selected
+                next unless $form->param("crdt$_" . "subj") ne "";
+                $subform = new CGI("");
+                $subform->param("form", "new");
+                $subform->param("trx", $self->{"sn"});
+                $subform->param("credit", 1);
+                $subform->param("ord", $o++);
+                $subform->param("subj", $form->param("crdt$_" . "subj"));
+                $subform->param("summary", $form->param("crdt$_" . "summary"));
+                $subform->param("amount", $form->param("crdt$_" . "amount"));
+                $cols = new Selima::Processor::AcctRec($subform);
+                $cols->_save_cols;
+                push @{$self->{"subs"}}, $cols;
+            }
+        }
+    
+    # A form to edit a current item
+    } elsif ($self->{"type"} eq "cur") {
+        # Shrink to the maximum order
+        $myord = $form->param("ord");
+        $myord = accttrx_maxord $form->param("date")
+            if $self->{"fix_ord"} && $myord > accttrx_maxord $form->param("date"), $self->{"sn"};
+        $self->{"myord"} = $myord;
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
+        $self->{"cols"}->adddate("date", $self->_form("date"), scalar $cur->param("date"));
+        $self->{"cols"}->addnum("ord", $myord, scalar $cur->param("ord"));
+        $self->{"cols"}->addstr("note", $self->_form("note"), scalar $cur->param("note"));
+        
+        # Fix the order of other records
+        if ($self->{"fix_ord"}) {
+            my ($sql, $sth, $count, $row);
+            # Date changed
+            if (fmtdate($cur->param("date")) ne $form->param("date")) {
+                $sql = "SELECT * FROM " . $self->{"table"}
+                    . " WHERE date=" . $DBH->quote(fmtdate $cur->param("date"))
+                    . " AND sn!=" . $self->{"sn"}
+                    . " ORDER BY ord;\n";
+                $sth = $DBH->prepare($sql);
+                $sth->execute;
+                $count = $sth->rows;
+                for ($_ = 0, $o = 1; $_ < $count; $_++, $o++) {
+                    my ($subform, $cols, %CURRENT_SUP);
+                    $row = $sth->fetchrow_hashref;
+                    next if $$row{"ord"} == $o;
+                    %CURRENT_SUP = %CURRENT;
+                    %CURRENT = (%$row);
+                    $subform = new CGI({%CURRENT});
+                    $subform->param("form", "cur");
+                    $subform->param("formsub", "trans");
+                    $subform->param("ord", $o);
+                    $subform->param("date", fmtdate($CURRENT{"date"}));
+                    $cols = new Selima::Processor::AcctTrx($subform);
+                    $cols->{"fix_ord"} = 0;
+                    $cols->_save_cols;
+                    unshift @{$self->{"pres"}}, $cols;
+                    %CURRENT = %CURRENT_SUP;
+                }
+            }
+            $sql = "SELECT * FROM " . $self->{"table"}
+                . " WHERE date=" . $DBH->quote($form->param("date"))
+                . " AND sn!=" . $self->{"sn"}
+                . " ORDER BY ord;\n";
+            $sth = $DBH->prepare($sql);
+            $sth->execute;
+            $count = $sth->rows;
+            for ($_ = 0, $o = 1; $_ < $count; $_++, $o++) {
+                my ($subform, $cols, %CURRENT_SUP);
+                $row = $sth->fetchrow_hashref;
+                $o++ if $o == $myord;
+                next if $$row{"ord"} == $o;
+                %CURRENT_SUP = %CURRENT;
+                %CURRENT = (%$row);
+                $subform = new CGI({%CURRENT});
+                $subform->param("form", "cur");
+                $subform->param("formsub", "trans");
+                $subform->param("ord", $o);
+                $subform->param("date", fmtdate($CURRENT{"date"}));
+                $cols = new Selima::Processor::AcctTrx($subform);
+                $cols->{"fix_ord"} = 0;
+                $cols->_save_cols;
+                unshift @{$self->{"pres"}}, $cols;
+                %CURRENT = %CURRENT_SUP;
+            }
+        }
+        
+        # Find the changed items
+        if ($self->{"fix_ord"}) {
+            @_ = qw();
+            # The debit records
+            for (   $_ = 0, $o = 1;
+                    $_ < $cur->param("debtcount")
+                    || defined $form->param("debt$_" . "subj");
+                    $_++) {
+                # Added items to the current
+                if ($_ >= $cur->param("debtcount")) {
+                    my ($subform, $cols);
+                    # Not selected
+                    next unless $form->param("debt$_" . "subj") ne "";
+                    $subform = new CGI("");
+                    $subform->param("form", "new");
+                    $subform->param("trx", $self->{"sn"});
+                    $subform->delete("credit");
+                    $subform->param("ord", $o++);
+                    $subform->param("subj", $form->param("debt$_" . "subj"));
+                    $subform->param("summary", $form->param("debt$_" . "summary"));
+                    $subform->param("amount", $form->param("debt$_" . "amount"));
+                    $cols = new Selima::Processor::AcctRec($subform);
+                    $cols->_save_cols;
+                    push @{$self->{"subs"}}, $cols;
+                
+                # Selected
+                } elsif ($form->param("debt$_" . "subj") ne "") {
+                    my ($subform, $cols, %CURRENT_SUP);
+                    %CURRENT_SUP = %CURRENT;
+                    %CURRENT = (
+                        "sn"        => $cur->param("debt$_" . "sn"),
+                        "trx"       => $self->{"sn"},
+                        "credit"    => undef,
+                        "ord"       => $cur->param("debt$_" . "ord"),
+                        "subj"      => $cur->param("debt$_" . "subj"),
+                        "summary"   => scalar $cur->param("debt$_" . "summary"),
+                        "amount"    => $cur->param("debt$_" . "amount"),
+                    );
+                    $subform = new CGI("");
+                    $subform->param("form", "cur");
+                    $subform->param("sn", $cur->param("debt$_" . "sn"));
+                    $subform->param("trx", $self->{"sn"});
+                    $subform->delete("credit");
+                    $subform->param("ord", $o++);
+                    $subform->param("subj", $form->param("debt$_" . "subj"));
+                    $subform->param("summary", $form->param("debt$_" . "summary"));
+                    $subform->param("amount", $form->param("debt$_" . "amount"));
+                    $cols = new Selima::Processor::AcctRec($subform);
+                    $cols->_save_cols;
+                    push @{$self->{"subs"}}, $cols;
+                    %CURRENT = %CURRENT_SUP;
+                
+                # Not selected
+                } else {
+                    push @_, $cur->param("debt$_" . "sn");
+                }
+            }
+            # The credit records
+            for (   $_ = 0, $o = 1;
+                    $_ < $cur->param("crdtcount")
+                    || defined $form->param("crdt$_" . "subj");
+                    $_++) {
+                # Added items to the current
+                if ($_ >= $cur->param("crdtcount")) {
+                    my ($subform, $cols);
+                    # Not selected
+                    next unless $form->param("crdt$_" . "subj") ne "";
+                    $subform = new CGI("");
+                    $subform->param("form", "new");
+                    $subform->param("trx", $self->{"sn"});
+                    $subform->param("credit", 1);
+                    $subform->param("ord", $o++);
+                    $subform->param("subj", $form->param("crdt$_" . "subj"));
+                    $subform->param("summary", $form->param("crdt$_" . "summary"));
+                    $subform->param("amount", $form->param("crdt$_" . "amount"));
+                    $cols = new Selima::Processor::AcctRec($subform);
+                    $cols->_save_cols;
+                    push @{$self->{"subs"}}, $cols;
+                
+                # Selected
+                } elsif ($form->param("crdt$_" . "subj") ne "") {
+                    my ($subform, $cols, %CURRENT_SUP);
+                    %CURRENT_SUP = %CURRENT;
+                    %CURRENT = (
+                        "sn"        => $cur->param("crdt$_" . "sn"),
+                        "trx"       => $self->{"sn"},
+                        "credit"    => 1,
+                        "ord"       => $cur->param("crdt$_" . "ord"),
+                        "subj"      => $cur->param("crdt$_" . "subj"),
+                        "summary"   => scalar $cur->param("crdt$_" . "summary"),
+                        "amount"    => $cur->param("crdt$_" . "amount"),
+                    );
+                    $subform = new CGI("");
+                    $subform->param("form", "cur");
+                    $subform->param("sn", $cur->param("crdt$_" . "sn"));
+                    $subform->param("trx", $self->{"sn"});
+                    $subform->param("credit", 1);
+                    $subform->param("ord", $o++);
+                    $subform->param("subj", $form->param("crdt$_" . "subj"));
+                    $subform->param("summary", $form->param("crdt$_" . "summary"));
+                    $subform->param("amount", $form->param("crdt$_" . "amount"));
+                    $cols = new Selima::Processor::AcctRec($subform);
+                    $cols->_save_cols;
+                    push @{$self->{"subs"}}, $cols;
+                    %CURRENT = %CURRENT_SUP;
+                
+                # Not selected
+                } else {
+                    push @_, $cur->param("crdt$_" . "sn");
+                }
+            }
+            
+            # Debit and credit records are in a same table
+            if (@_ > 0) {
+                my $subform;
+                $_ = join " OR ", map "sn=$_", @_;
+                $subform = new CGI("");
+                $subform->param("cond", $_);
+                # Delete first, to spare the order occupied
+                unshift @{$self->{"pres"}}, new Selima::Processor::Deletion($subform, "acctrecs");
+            }
+        }
+    
+    # A form to delete a current item
+    } elsif ($self->{"type"} eq "del") {
+        # Fix the order of other records
+        if ($self->{"fix_ord"}) {
+            my ($sql, $sth, $count, $row);
+            $sql = "SELECT * FROM " . $self->{"table"}
+                . " WHERE date=" . $DBH->quote(fmtdate $cur->param("date"))
+                . " AND sn!=" . $self->{"sn"}
+                . " ORDER BY ord;\n";
+            $sth = $DBH->prepare($sql);
+            $sth->execute;
+            $count = $sth->rows;
+            for ($_ = 0, $o = 1; $_ < $count; $_++, $o++) {
+                my ($subform, $cols, %CURRENT_SUP);
+                $row = $sth->fetchrow_hashref;
+                next if $$row{"ord"} == $o;
+                %CURRENT_SUP = %CURRENT;
+                %CURRENT = (%$row);
+                $subform = new CGI({%CURRENT});
+                $subform->param("form", "cur");
+                $subform->param("formsub", "trans");
+                $subform->param("ord", $o);
+                $subform->param("date", fmtdate($CURRENT{"date"}));
+                $cols = new Selima::Processor::AcctTrx($subform);
+                $cols->{"fix_ord"} = 0;
+                $cols->_save_cols;
+                unshift @{$self->{"pres"}}, $cols;
+                %CURRENT = %CURRENT_SUP;
+            }
+        }
+        
+        # Find the changed items
+        if ($self->{"fix_ord"}) {
+            $_ = new CGI("");
+            $_->param("cond", "trx=" . $self->{"sn"});
+            push @{$self->{"subs"}}, new Selima::Processor::Deletion($_, "acctrecs");
+        }
+    }
+    return;
+}
+
+# _actlog: Log the activity
+sub _actlog : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    return gactlog "Create an accounting transaction "
+            . accttrxid_compose($form->param("date"), $self->{"myord"})
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return gactlog "Update the accounting transaction "
+            . accttrxid_compose($form->param("date"), $self->{"myord"})
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return gactlog "Delete the accounting transaction "
+            . accttrxid_compose($cur->param("date"), $cur->param("ord"))
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "del";
+}
+
+# _ret_status: Return the process status
+sub _ret_status : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    return {"msg"=>N_("This accounting transaction was not modified."),
+            "isform"=>0}
+        if !$self->_modified;
+    # A form to create a new item
+    return {"msg"=>N_("This accounting transaction has been successfully added."),
+            "isform"=>0}
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return {"msg"=>N_("This accounting transaction has been successfully updated."),
+            "isform"=>0}
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return {"msg"=>N_("This accounting transaction has been successfully deleted."),
+            "isform"=>0}
+        if $self->{"type"} eq "del";
+}
+
+return 1;

lib/perl5/Selima/Processor/Category.pm

@@ -0,0 +1,51 @@
+# Selima Website Content Management System
+# Category.pm: The base category data processor.
+
+#  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-03-18
+
+package Selima::Processor::Category;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor);
+
+use Selima::ShortCut;
+
+# _ret_status: Return the process status
+sub _ret_status : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    return {"msg"=>N_("This category was not modified."),
+            "isform"=>0}
+        if !$self->_modified;
+    # A form to create a new item
+    return {"msg"=>N_("This category has been successfully added."),
+            "isform"=>0}
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return {"msg"=>N_("This category has been successfully updated."),
+            "isform"=>0}
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return {"msg"=>N_("This category has been successfully deleted."),
+            "isform"=>0}
+        if $self->{"type"} eq "del";
+}
+
+return 1;

lib/perl5/Selima/Processor/Categorz.pm

@@ -0,0 +1,51 @@
+# Selima Website Content Management System
+# Categorz.pm: The base category membership data processor.
+
+#  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-03-17
+
+package Selima::Processor::Categorz;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor);
+
+use Selima::ShortCut;
+
+# _ret_status: Return the process status
+sub _ret_status : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    return {"msg"=>N_("This categorization record was not modified."),
+            "isform"=>0}
+        if !$self->_modified;
+    # A form to create a new item
+    return {"msg"=>N_("This categorization record has been successfully added."),
+            "isform"=>0}
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return {"msg"=>N_("This categorization record has been successfully updated."),
+            "isform"=>0}
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return {"msg"=>N_("This categorization record has been successfully deleted."),
+            "isform"=>0}
+        if $self->{"type"} eq "del";
+}
+
+return 1;

lib/perl5/Selima/Processor/Deletion.pm

@@ -0,0 +1,52 @@
+# Selima Website Content Management System
+# Deletion.pm: The data deletion processor.
+
+#  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-03-17
+
+package Selima::Processor::Deletion;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor);
+
+use Selima::DataVars qw($DBH);
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[0]->param("form", "del");
+    $self = $class->SUPER::new(@_);
+    $self->{"cond"} = $self->{"form"}->param("cond");
+    return $self;
+}
+
+# _update_cols: Update the columns
+sub _update_cols : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Process the update
+    $_ = "DELETE FROM " . $self->{"table"}
+        . " WHERE " . $self->{"cond"} . ";\n";
+    $DBH->gdo($_);
+    return;
+}
+
+return 1;

lib/perl5/Selima/Processor/Group.pm

@@ -0,0 +1,284 @@
+# Selima Website Content Management System
+# Group.pm: The account group data processor.
+
+#  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-03-17
+
+package Selima::Processor::Group;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor);
+
+use CGI;
+
+use Selima::ChkPriv;
+use Selima::DataVars qw(:addcol);
+use Selima::Guest;
+use Selima::LogIn;
+use Selima::ShortCut;
+use Selima::UserName;
+
+use Selima::Processor::UserMem;
+use Selima::Processor::GroupMem;
+use Selima::Processor::Deletion;
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "groups" if @_ < 2;
+    $self = $class->SUPER::new(@_);
+    return $self;
+}
+
+# _save_cols: Save the column deposit
+sub _save_cols : method {
+    local ($_, %_);
+    my ($self, $form, $cur, @olditems, @newitems, @additems, @delitems);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    if ($self->{"type"} eq "new") {
+        $self->{"sn"} = $self->_new_sn;
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_INSERT);
+        $self->{"cols"}->addnum("sn", $self->{"sn"});
+        $self->{"cols"}->addstr("id", $self->_form("id"));
+        $self->{"cols"}->addstr("dsc", $self->_form("dsc"));
+        
+        # Find the changed items
+        @additems = qw();
+        for ($_ = 0; defined $form->param("subuser$_" . "sn"); $_++) {
+            push @additems, $form->param("subuser$_" . "sn")
+                if defined $form->param("subuser$_");
+        }
+        foreach my $item (@additems) {
+            my ($subform, $cols);
+            $subform = new CGI("");
+            $subform->param("form", "new");
+            $subform->param("grp", $self->{"sn"});
+            $subform->param("member", $item);
+            $cols = new Selima::Processor::UserMem($subform);
+            $cols->_save_cols;
+            push @{$self->{"subs"}}, $cols;
+        }
+        
+        @additems = qw();
+        for ($_ = 0; defined $form->param("subgroup$_" . "sn"); $_++) {
+            push @additems, $form->param("subgroup$_" . "sn")
+                if defined $form->param("subgroup$_");
+        }
+        foreach my $item (@additems) {
+            my ($subform, $cols);
+            $subform = new CGI("");
+            $subform->param("form", "new");
+            $subform->param("grp", $self->{"sn"});
+            $subform->param("member", $item);
+            $cols = new Selima::Processor::GroupMem($subform);
+            $cols->_save_cols;
+            push @{$self->{"subs"}}, $cols;
+        }
+        
+        @additems = qw();
+        for ($_ = 0; defined $form->param("supgroup$_" . "sn"); $_++) {
+            push @additems, $form->param("supgroup$_" . "sn")
+                if defined $form->param("supgroup$_");
+        }
+        foreach my $item (@additems) {
+            my ($subform, $cols);
+            $subform = new CGI("");
+            $subform->param("form", "new");
+            $subform->param("grp", $item);
+            $subform->param("member", $self->{"sn"});
+            $cols = new Selima::Processor::GroupMem($subform);
+            $cols->_save_cols;
+            push @{$self->{"subs"}}, $cols;
+        }
+    
+    # A form to edit a current item
+    } elsif ($self->{"type"} eq "cur") {
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
+        # Skip for non-super-user editing a super-user-group
+        unless (!is_su && $self->{"sn"} == su_group_sn) {
+            $self->{"cols"}->addstr("id", $self->_form("id"), scalar $cur->param("id"));
+        }
+        $self->{"cols"}->addstr("dsc", $self->_form("dsc"), scalar $cur->param("dsc"));
+        
+        # Find the changed items
+        @olditems = qw();
+        @newitems = qw();
+        # Skip for a non-super-user editing a super-user group
+        unless (!is_su && $self->{"sn"} == get_login_sn) {
+            for ($_ = 0; $_ < $cur->param("subusercount"); $_++) {
+                push @olditems, $cur->param("subuser$_" . "sn");
+            }
+            for ($_ = 0; defined $form->param("subuser$_" . "sn"); $_++) {
+                push @newitems, $form->param("subuser$_" . "sn")
+                    if defined $form->param("subuser$_");
+            }
+        }
+        %_ = map { $_ => 1 } @newitems;
+        @delitems = grep !exists $_{$_}, @olditems;
+        %_ = map { $_ => 1 } @olditems;
+        @additems = grep !exists $_{$_}, @newitems;
+        foreach my $item (@additems) {
+            my ($subform, $cols);
+            $subform = new CGI("");
+            $subform->param("form", "new");
+            $subform->param("grp", $self->{"sn"});
+            $subform->param("member", $item);
+            $cols = new Selima::Processor::UserMem($subform);
+            $cols->_save_cols;
+            push @{$self->{"subs"}}, $cols;
+        }
+        if (@delitems > 0) {
+            my $subform;
+            @_ = map "member=$_", @delitems;
+            $_ = (scalar(@_) == 1)? $_[0]: "(" . join(" OR ", @_) . ")";
+            $subform = new CGI("");
+            $subform->param("cond", "$_ AND grp=" . $self->{"sn"});
+            push @{$self->{"subs"}}, new Selima::Processor::Deletion($subform, "usermem");
+        }
+        
+        @olditems = qw();
+        @newitems = qw();
+        # Skip for a non-super-user editing a super-user group
+        unless (!is_su && $self->{"sn"} == get_login_sn) {
+            for ($_ = 0; $_ < $cur->param("subgroupcount"); $_++) {
+                push @olditems, $cur->param("subgroup$_" . "sn");
+            }
+            for ($_ = 0; defined $form->param("subgroup$_" . "sn"); $_++) {
+                push @newitems, $form->param("subgroup$_" . "sn")
+                    if defined $form->param("subgroup$_");
+            }
+        }
+        %_ = map { $_ => 1 } @newitems;
+        @delitems = grep !exists $_{$_}, @olditems;
+        %_ = map { $_ => 1 } @olditems;
+        @additems = grep !exists $_{$_}, @newitems;
+        foreach my $item (@additems) {
+            my ($subform, $cols);
+            $subform = new CGI("");
+            $subform->param("form", "new");
+            $subform->param("grp", $self->{"sn"});
+            $subform->param("member", $item);
+            $cols = new Selima::Processor::GroupMem($subform);
+            $cols->_save_cols;
+            push @{$self->{"subs"}}, $cols;
+        }
+        if (@delitems > 0) {
+            my $subform;
+            @_ = map "member=$_", @delitems;
+            $_ = (scalar(@_) == 1)? $_[0]: "(" . join(" OR ", @_) . ")";
+            $subform = new CGI("");
+            $subform->param("cond", "$_ AND grp=" . $self->{"sn"});
+            push @{$self->{"subs"}}, new Selima::Processor::Deletion($subform, "groupmem");
+        }
+        
+        @olditems = qw();
+        @newitems = qw();
+        # Skip for a non-super-user editing a super-user group
+        unless (!is_su && $self->{"sn"} == get_login_sn) {
+            for ($_ = 0; $_ < $cur->param("supgroupcount"); $_++) {
+                push @olditems, $cur->param("supgroup$_" . "sn");
+            }
+            for ($_ = 0; defined $form->param("supgroup$_" . "sn"); $_++) {
+                push @newitems, $form->param("supgroup$_" . "sn")
+                    if defined $form->param("supgroup$_");
+            }
+        }
+        %_ = map { $_ => 1 } @newitems;
+        @delitems = grep !exists $_{$_}, @olditems;
+        %_ = map { $_ => 1 } @olditems;
+        @additems = grep !exists $_{$_}, @newitems;
+        foreach my $item (@additems) {
+            my ($subform, $cols);
+            $subform = new CGI("");
+            $subform->param("form", "new");
+            $subform->param("grp", $item);
+            $subform->param("member", $self->{"sn"});
+            $cols = new Selima::Processor::GroupMem($subform);
+            $cols->_save_cols;
+            push @{$self->{"subs"}}, $cols;
+        }
+        if (@delitems > 0) {
+            my $subform;
+            @_ = map "grp=$_", @delitems;
+            $_ = (scalar(@_) == 1)? $_[0]: "(" . join(" OR ", @_) . ")";
+            $subform = new CGI("");
+            $subform->param("cond", "$_ AND member=" . $self->{"sn"});
+            push @{$self->{"subs"}}, new Selima::Processor::Deletion($subform, "groupmem");
+        }
+    
+    # A form to delete a current item
+    } elsif ($self->{"type"} eq "del") {
+        # Find the changed items
+        $_ = new CGI("");
+        $_->param("cond", "grp=" . $self->{"sn"});
+        push @{$self->{"subs"}}, new Selima::Processor::Deletion($_, "usermem");
+        
+        $_ = new CGI("");
+        $_->param("cond", "grp=" . $self->{"sn"} . " OR member=" . $self->{"sn"});
+        push @{$self->{"subs"}}, new Selima::Processor::Deletion($_, "groupmem");
+    }
+    return;
+}
+
+# _actlog: Log the activity
+sub _actlog : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    return gactlog "Create a group " . $form->param("id")
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return gactlog "Update the group " . $form->param("id")
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return gactlog "Delete the group " . $cur->param("id")
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "del";
+}
+
+# _ret_status: Return the process status
+sub _ret_status : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    return {"msg"=>N_("This group was not modified."),
+            "isform"=>0}
+        if !$self->_modified;
+    # A form to create a new item
+    return {"msg"=>N_("This group has been successfully added."),
+            "isform"=>0}
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return {"msg"=>N_("This group has been successfully updated."),
+            "isform"=>0}
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return {"msg"=>N_("This group has been successfully deleted."),
+            "isform"=>0}
+        if $self->{"type"} eq "del";
+}
+
+return 1;

lib/perl5/Selima/Processor/GroupMem.pm

@@ -0,0 +1,110 @@
+# Selima Website Content Management System
+# GroupMem.pm: The group-to-group membership data processor.
+
+#  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-03-17
+
+package Selima::Processor::GroupMem;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor);
+
+use Selima::DataVars qw(:addcol);
+use Selima::Guest;
+use Selima::ShortCut;
+use Selima::UserName;
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "groupmem" if @_ < 2;
+    $self = $class->SUPER::new(@_);
+    return $self;
+}
+
+# _save_cols: Save the column deposit
+sub _save_cols : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    if ($self->{"type"} eq "new") {
+        $self->{"sn"} = $self->_new_sn;
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_INSERT);
+        $self->{"cols"}->addnum("sn", $self->{"sn"});
+        $self->{"cols"}->addnum("grp", $self->_form("grp"));
+        $self->{"cols"}->addnum("member", $self->_form("member"));
+    
+    # A form to edit a current item
+    } elsif ($self->{"type"} eq "cur") {
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
+        $self->{"cols"}->addnum("grp", $self->_form("grp"), scalar $cur->param("grp"));
+        $self->{"cols"}->addnum("member", $self->_form("member"), scalar $cur->param("member"));
+    }
+    return;
+}
+
+# _actlog: Log the activity
+sub _actlog : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    return gactlog "Create a group membership " . groupid($form->param("member"))
+            . " in group " . groupid($form->param("grp"))
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return gactlog "Update the group membership " . groupid($form->param("member"))
+            . " in group " . groupid($form->param("grp"))
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return gactlog "Delete the group membership " . groupid($cur->param("member"))
+            . " in group " . groupid($cur->param("grp"))
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "del";
+}
+
+# _ret_status: Return the process status
+sub _ret_status : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    return {"msg"=>N_("This group membership record was not modified."),
+            "isform"=>0}
+        if !$self->_modified;
+    # A form to create a new item
+    return {"msg"=>N_("This group membership record has been successfully added."),
+            "isform"=>0}
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return {"msg"=>N_("This group membership record has been successfully updated."),
+            "isform"=>0}
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return {"msg"=>N_("This group membership record has been successfully deleted."),
+            "isform"=>0}
+        if $self->{"type"} eq "del";
+}
+
+return 1;

lib/perl5/Selima/Processor/Guestbook.pm

@@ -0,0 +1,148 @@
+# Selima Website Content Management System
+# Guestbook.pm: The base guestbook data processor.
+
+#  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-03-19
+
+package Selima::Processor::Guestbook;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor);
+
+use Selima::DataVars qw($DBH :addcol);
+use Selima::Format;
+use Selima::Guest;
+use Selima::GeoIP;
+use Selima::Guestbook;
+use Selima::RemoHost;
+use Selima::ShortCut;
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "guestbook" if @_ < 2;
+    $self = $class->SUPER::new(@_);
+    $self->{"page_size"} = 2560;
+    $self->{"form_cols"} = [qw(name identity location email url message)];
+    return $self;
+}
+
+# _save_cols: Save the column deposit
+sub _save_cols : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    if ($self->{"type"} eq "new") {
+        $self->{"sn"} = $self->_new_sn;
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_INSERT);
+        $self->{"cols"}->addnum("sn", $self->{"sn"});
+        $self->{"cols"}->addstr("name", $self->_form("name"));
+        $self->{"cols"}->addstr("identity", $self->_form("identity"));
+        $self->{"cols"}->addstr("location", $self->_form("location"));
+        $self->{"cols"}->addstr("email", $self->_form("email"));
+        $self->{"cols"}->addurl("url", $self->_form("url"));
+        $self->{"cols"}->addstr("message", $self->_form("message"));
+        $self->{"cols"}->addbool("hid", $self->_form("hid"));
+        $self->{"cols"}->addipaddr("ip", $ENV{"REMOTE_ADDR"});
+        $self->{"cols"}->addstr("host", remote_host);
+        $self->{"cols"}->addstr("ct", country_lookup);
+        $self->{"cols"}->addnum("pageno", 1);
+    
+    # A form to edit a current item
+    } elsif ($self->{"type"} eq "cur") {
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
+        $self->{"cols"}->addstr("name", $self->_form("name"), scalar $cur->param("name"));
+        $self->{"cols"}->addstr("identity", $self->_form("identity"), scalar $cur->param("identity"));
+        $self->{"cols"}->addstr("location", $self->_form("location"), scalar $cur->param("title_2ln"));
+        $self->{"cols"}->addstr("email", $self->_form("email"), scalar $cur->param("email"));
+        $self->{"cols"}->addurl("url", $self->_form("url"), scalar $cur->param("url"));
+        $self->{"cols"}->addstr("message", $self->_form("message"), scalar $cur->param("message"));
+        $self->{"cols"}->addbool("hid", $self->_form("hid"), scalar $cur->param("hid"));
+    }
+    return;
+}
+
+# _update_cols: Update the columns
+sub _update_cols : method {
+    local ($_, %_);
+    my $self;
+    ($self, @_) = @_;
+    $self->SUPER::_update_cols(@_);
+    # Update the page number
+    if ($self->{"type"} eq "new") {
+        my ($sql, $sth, $row);
+        $sql = "SELECT created FROM " . $self->{"table"}
+            . " WHERE sn=" . $self->{"sn"} . ";\n";
+        $sth = $DBH->prepare($sql);
+        $sth->execute;
+        $row = $sth->fetchrow_hashref;
+        $self->{"date"} = $$row{"created"};
+    } else {
+        $self->{"date"} = $self->{"cur"}->param("created");
+    }
+    update_pageno $self->{"table"}, $self->{"page_size"},
+        $self->{"form_cols"}, $self->{"date"};
+    return;
+}
+
+# _actlog: Log the activity
+sub _actlog : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # A form to create a new item
+    return gactlog "Create a message on " . fmtdate($self->{"date"})
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return gactlog "Update the message on " . fmtdate($self->{"date"})
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return gactlog "Delete the message on " . fmtdate($self->{"date"})
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "del";
+}
+
+# _ret_status: Return the process status
+sub _ret_status : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    return {"msg"=>N_("This message was not modified."),
+            "isform"=>0}
+        if !$self->_modified;
+    # A form to create a new item
+    return {"msg"=>N_("This message has been successfully added."),
+            "isform"=>0}
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return {"msg"=>N_("This message has been successfully updated."),
+            "isform"=>0}
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return {"msg"=>N_("This message has been successfully deleted."),
+            "isform"=>0}
+        if $self->{"type"} eq "del";
+}
+
+return 1;

lib/perl5/Selima/Processor/Link.pm

@@ -0,0 +1,337 @@
+# Selima Website Content Management System
+# Link.pm: The related-link data processor.
+
+#  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-03-18
+
+package Selima::Processor::Link;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor);
+
+use CGI;
+
+use Selima::DataVars qw($DBH :addcol :scptconf);
+use Selima::Guest;
+use Selima::Links;
+use Selima::ShortCut;
+
+use Selima::Processor::LinkCatz;
+use Selima::Processor::Deletion;
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "links" if @_ < 2;
+    $self = $class->SUPER::new(@_);
+    return $self;
+}
+
+# _save_cols: Save the column deposit
+sub _save_cols : method {
+    local ($_, %_);
+    my ($self, $form, $cur, @olditems, @newitems, @additems, @delitems);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    if ($self->{"type"} eq "new") {
+        $self->{"sn"} = $self->_new_sn;
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_INSERT);
+        $self->{"cols"}->addnum("sn", $self->{"sn"});
+        $self->{"cols"}->addstr("title", $self->_form("title"));
+        $self->{"cols"}->addstr("title_2ln", $self->_form("title_2ln"));
+        $self->{"cols"}->addurl("url", $self->_form("url"));
+        $self->{"cols"}->addstr("email", $self->_form("email"));
+        $self->{"cols"}->addurl("icon", $self->_form("icon"));
+        $self->{"cols"}->addstr("addr", $self->_form("addr"));
+        $self->{"cols"}->addstr("tel", $self->_form("tel"));
+        $self->{"cols"}->addstr("fax", $self->_form("fax"));
+        $self->{"cols"}->addstr("dsc", $self->_form("dsc"));
+        $self->{"cols"}->addbool("hid", $self->_form("hid"));
+        # Automatic Traditional Chinese to Simplified Chinese conversion
+        $self->_zhsync;
+        
+        # Find the changed items
+        @additems = qw();
+        for ($_ = 0; defined $form->param("cat$_"); $_++) {
+            push @additems, $form->param("cat$_")
+                if $form->param("cat$_") ne "";
+        }
+        foreach my $item (@additems) {
+            my ($subform, $cols);
+            $subform = new CGI("");
+            $subform->param("form", "new");
+            $subform->param("cat", $item);
+            $subform->param("link", $self->{"sn"});
+            $cols = new Selima::Processor::LinkCatz($subform);
+            $cols->_save_cols;
+            push @{$self->{"subs"}}, $cols;
+        }
+    
+    # A form to edit a current item
+    } elsif ($self->{"type"} eq "cur") {
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
+        $self->{"cols"}->addstr("title", $self->_form("title"), scalar $cur->param("title"));
+        $self->{"cols"}->addstr("title_2ln", $self->_form("title_2ln"), scalar $cur->param("title_2ln"));
+        $self->{"cols"}->addurl("url", $self->_form("url"), scalar $cur->param("url"));
+        $self->{"cols"}->addstr("email", $self->_form("email"), scalar $cur->param("email"));
+        $self->{"cols"}->addurl("icon", $self->_form("icon"), scalar $cur->param("icon"));
+        $self->{"cols"}->addstr("addr", $self->_form("addr"), scalar $cur->param("addr"));
+        $self->{"cols"}->addstr("tel", $self->_form("tel"), scalar $cur->param("tel"));
+        $self->{"cols"}->addstr("fax", $self->_form("fax"), scalar $cur->param("fax"));
+        $self->{"cols"}->addstr("dsc", $self->_form("dsc"), scalar $cur->param("dsc"));
+        $self->{"cols"}->addbool("hid", $self->_form("hid"), scalar $cur->param("hid"));
+        # Automatic Traditional Chinese to Simplified Chinese conversion
+        $self->_zhsync;
+        
+        # Find the changed items
+        @olditems = qw();
+        @newitems = qw();
+        for ($_ = 0; $_ < $cur->param("catcount"); $_++) {
+            push @olditems, $cur->param("cat$_");
+        }
+        for ($_ = 0; defined $form->param("cat$_"); $_++) {
+            push @newitems, $form->param("cat$_")
+                if $form->param("cat$_") ne "";
+        }
+        %_ = map { $_ => 1 } @newitems;
+        @delitems = grep !exists $_{$_}, @olditems;
+        %_ = map { $_ => 1 } @olditems;
+        @additems = grep !exists $_{$_}, @newitems;
+        foreach my $item (@additems) {
+            my ($subform, $cols);
+            $subform = new CGI("");
+            $subform->param("form", "new");
+            $subform->param("cat", $item);
+            $subform->param("link", $self->{"sn"});
+            $cols = new Selima::Processor::LinkCatz($subform);
+            $cols->_save_cols;
+            push @{$self->{"subs"}}, $cols;
+        }
+        if (@delitems > 0) {
+            my $subform;
+            @_ = map "cat=$_", @delitems;
+            $_ = (scalar(@_) == 1)? $_[0]: "(" . join(" OR ", @_) . ")";
+            $subform = new CGI("");
+            $subform->param("cond", "$_ AND link=" . $self->{"sn"});
+            push @{$self->{"subs"}}, new Selima::Processor::Deletion($subform, "linkcatz");
+        }
+    
+    # A form to delete a current item
+    } elsif ($self->{"type"} eq "del") {
+        # Find the changed items
+        $_ = new CGI("");
+        $_->param("cond", "link=" . $self->{"sn"});
+        push @{$self->{"subs"}}, new Selima::Processor::Deletion($_, "linkcatz");
+    }
+    return;
+}
+
+# _update_cols: Update the columns
+sub _update_cols : method {
+    local ($_, %_);
+    my $self;
+    ($self, @_) = @_;
+    $self->{"curshown"} = $self->_shown_parts;
+    $self->SUPER::_update_cols(@_);
+    return;
+}
+
+# _actlog: Log the activity
+sub _actlog : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    return gactlog "Create a related link " . $form->param("url")
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return gactlog "Update the related link " . $form->param("url")
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return gactlog "Delete the related link " . $cur->param("url")
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "del";
+}
+
+# _ret_status: Return the process status
+sub _ret_status : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    return {"msg"=>N_("This related link was not modified."),
+            "isform"=>0}
+        if !$self->_modified;
+    # A form to create a new item
+    return {"msg"=>N_("This related link has been successfully added."),
+            "isform"=>0}
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return {"msg"=>N_("This related link has been successfully updated."),
+            "isform"=>0}
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return {"msg"=>N_("This related link has been successfully deleted."),
+            "isform"=>0}
+        if $self->{"type"} eq "del";
+}
+
+# _rebuild_partial_pages: Rebuild a limited part of pages
+sub _rebuild_partial_pages : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    my ($sql, @parents, @cats, @oldcats, @newcats, $cond);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    $self->{"newshown"} = $self->_shown_parts;
+    # Remove the unwanted pages
+    $self->_remove_curfile;
+    
+    # Find the affected parents
+    @parents = qw();
+    @_ = qw();
+    %_ = map { $_ => 1 } @{${$self->{"curshown"}}{"cats"}};
+    push @_, grep !exists $_{$_}, @{${$self->{"newshown"}}{"cats"}};
+    %_ = map { $_ => 1 } @{${$self->{"newshown"}}{"cats"}};
+    push @_, grep !exists $_{$_}, @{${$self->{"curshown"}}{"cats"}};
+    if (@_ > 0) {
+        my ($sql, $sth, $count, $row);
+        $sql = "SELECT parent FROM linkcat"
+            . " WHERE " . join(" OR ", map "sn=$_", @_)
+            . " GROUP BY parent;\n";
+        $sth = $DBH->prepare($sql);
+        $sth->execute;
+        $count = $sth->rows;
+        for ($_ = 0; $_ < $count; $_++) {
+            push @parents, ${$sth->fetch}[0];
+        }
+    }
+    
+    # Add myself and my parents
+    @oldcats = qw();
+    @newcats = qw();
+    # A form to create a new item
+    if ($self->{"type"} eq "new") {
+        if (!defined $form->param("hid")) {
+            for ($_ = 0; defined $form->param("cat$_"); $_++) {
+                push @newcats, $form->param("cat$_")
+                    if $form->param("cat$_") ne "";
+            }
+        }
+    # A form to edit a current item
+    } elsif ($self->{"type"} eq "cur") {
+        if (!$cur->param("hid")) {
+            for ($_ = 0; $_ < $cur->param("catcount"); $_++) {
+                push @oldcats, $cur->param("cat$_");
+            }
+        }
+        if (!defined $form->param("hid")) {
+            for ($_ = 0; defined $form->param("cat$_"); $_++) {
+                push @newcats, $form->param("cat$_")
+                    if $form->param("cat$_") ne "";
+            }
+        }
+    # A form to delete a current item
+    } elsif ($self->{"type"} eq "del") {
+        if (!$cur->param("hid")) {
+            for ($_ = 0; $_ < $cur->param("catcount"); $_++) {
+                push @oldcats, $cur->param("cat$_");
+            }
+        }
+    }
+    @cats = qw();
+    %_ = map { $_ => 1 } (@oldcats, @newcats);
+    push @cats, keys %_;
+    # The statistics pages on their parents are affected
+    @_ = qw();
+    %_ = map { $_ => 1 } @oldcats;
+    push @_, grep !exists $_{$_}, @newcats;
+    %_ = map { $_ => 1 } @newcats;
+    push @_, grep !exists $_{$_}, @oldcats;
+    if (@_ > 0) {
+        my ($sql, $sth, $count);
+        $_ = join(" OR ", map "sn=$_", @_);
+        $_ = "($_)" if @_ > 1;
+        $sql = "SELECT parent FROM linkcat"
+            . " WHERE $_"
+            . " AND parent IS NOT NULL"
+            . " AND linkcat_isshown(sn, hid, parent)"
+            . " GROUP BY parent;\n";
+        $sth = $DBH->prepare($sql);
+        $sth->execute;
+        $count = $sth->rows;
+        for ($_ = 0; $_ < $count; $_++) {
+            push @cats, ${$sth->fetch}[0];
+        }
+    }
+    %_ = map { $_ => 1 } @cats;
+    @cats = keys %_;
+    
+    # Nothing to rebuild
+    return if @cats == 0 && @parents == 0;
+    
+    # Compose the SQL statement
+    @_ = qw();
+    push @_, "sn=" . $_ foreach @cats;
+    foreach (@parents) {
+        # The parent page and those share the same parent
+        if (defined $_) {
+            push @_, "sn=" . $_;
+            push @_, "parent=" . $_;
+        # The topmost pages
+        } else {
+            push @_, "parent IS NULL";
+        }
+    }
+    $cond = join " OR ", @_;
+    $cond = "($cond)" if @_ > 1;
+    @_ = $DBH->cols("linkcat");
+    push @_, $DBH->strcat("'/links'", "linkcat_path(sn, id, parent)")
+      . " AS path";
+    $sql = "SELECT " . join(", ", @_) . " FROM linkcat"
+        . " WHERE $cond"
+        . " AND linkcat_isshown(sn, hid, parent);\n";
+    # Rebuild the pages
+    $_ = $MAIN->can("rebuild_links");
+    &$_($sql);
+    return;
+}
+
+# _remove_curfile: Remove the unwanted page
+sub _remove_curfile : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Remove the unwanted category files
+    %_ = map { $_ => 1 } @{${$self->{"newshown"}}{"catspath"}};
+    grmoldpage $_
+        foreach grep !exists $_{$_}, @{${$self->{"curshown"}}{"catspath"}};
+    return;
+}
+
+# _shown_parts: Obtain the shown parts
+sub _shown_parts : method {
+    return links_shown_parts;
+}
+
+return 1;

lib/perl5/Selima/Processor/LinkCat.pm

@@ -0,0 +1,219 @@
+# Selima Website Content Management System
+# LinkCat.pm: The related-link category data processor.
+
+#  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-03-17
+
+package Selima::Processor::LinkCat;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor::Category);
+
+use Selima::DataVars qw($DBH :addcol :scptconf);
+use Selima::Guest;
+use Selima::Links;
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "linkcat" if @_ < 2;
+    $self = $class->SUPER::new(@_);
+    return $self;
+}
+
+# _save_cols: Save the column deposit
+sub _save_cols : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    if ($self->{"type"} ne "del") {
+        # Set the "topmost" parent
+        $form->delete("parent") if  defined $form->param("topmost")
+                                    && $form->param("topmost") eq "true";
+    }
+    # A form to create a new item
+    if ($self->{"type"} eq "new") {
+        $self->{"sn"} = $self->_new_sn;
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_INSERT);
+        $self->{"cols"}->addnum("sn", $self->{"sn"});
+        $self->{"cols"}->addnum("parent", $self->_form("parent"));
+        $self->{"cols"}->addstr("id", $self->_form("id"));
+        $self->{"cols"}->addnum("ord", $self->_form("ord"));
+        $self->{"cols"}->addstr("title", $self->_form("title"));
+        $self->{"cols"}->addstr("kw", $self->_form("kw"));
+        $self->{"cols"}->addbool("hid", $self->_form("hid"));
+        # Automatic Traditional Chinese to Simplified Chinese conversion
+        $self->_zhsync;
+    
+    # A form to edit a current item
+    } elsif ($self->{"type"} eq "cur") {
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
+        $self->{"cols"}->addnum("parent", $self->_form("parent"), scalar $cur->param("parent"));
+        $self->{"cols"}->addstr("id", $self->_form("id"), scalar $cur->param("id"));
+        $self->{"cols"}->addnum("ord", $self->_form("ord"), scalar $cur->param("ord"));
+        $self->{"cols"}->addstr("title", $self->_form("title"), scalar $cur->param("title"));
+        $self->{"cols"}->addstr("kw", $self->_form("kw"), scalar $cur->param("kw"));
+        $self->{"cols"}->addbool("hid", $self->_form("hid"), scalar $cur->param("hid"));
+        # Automatic Traditional Chinese to Simplified Chinese conversion
+        $self->_zhsync;
+    }
+    return;
+}
+
+# _update_cols: Update the columns
+sub _update_cols : method {
+    local ($_, %_);
+    my $self;
+    ($self, @_) = @_;
+    $self->{"curshown"} = $self->_shown_parts;
+    $self->SUPER::_update_cols(@_);
+    return;
+}
+
+# _actlog: Log the activity
+sub _actlog : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    return gactlog "Create a link category " . $form->param("id")
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return gactlog "Update the link category " . $form->param("id")
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return gactlog "Delete the link category " . $cur->param("id")
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "del";
+}
+
+# _rebuild_partial_pages: Rebuild a limited part of pages
+sub _rebuild_partial_pages : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    my ($sql, @parents, $build_myself, $cond);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    $self->{"newshown"} = $self->_shown_parts;
+    # Remove the unwanted pages
+    $self->_remove_curfile;
+    # Page was not shown, and is still not shown now
+    return unless   ${$self->{"curshown"}}{"self"}
+                    || ${$self->{"newshown"}}{"self"};
+    
+    # Find the affected parents
+    @parents = qw();
+    @_ = qw();
+    %_ = map { $_ => 1 } @{${$self->{"curshown"}}{"cats"}};
+    push @_, grep !exists $_{$_}, @{${$self->{"newshown"}}{"cats"}};
+    %_ = map { $_ => 1 } @{${$self->{"newshown"}}{"cats"}};
+    push @_, grep !exists $_{$_}, @{${$self->{"curshown"}}{"cats"}};
+    if (@_ > 0) {
+        my ($sql, $sth, $count, $row);
+        $sql = "SELECT parent FROM " . $DBH->quote_identifier($self->{"table"})
+            . " WHERE " . join(" OR ", map "sn=$_", @_)
+            . " GROUP BY parent;\n";
+        $sth = $DBH->prepare($sql);
+        $sth->execute;
+        $count = $sth->rows;
+        for ($_ = 0; $_ < $count; $_++) {
+            push @parents, ${$sth->fetch}[0];
+        }
+    }
+    
+    # Add myself and my parents
+    $build_myself = 0;
+    # A form to edit a current item
+    if ($self->{"type"} eq "cur") {
+        push @parents, $cur->param("parent")
+            if !$cur->param("hid");
+        if (!defined $form->param("hid")) {
+            push @parents, $form->param("parent");
+            $build_myself = 1;
+        }
+    # A form to delete a current item
+    } elsif ($self->{"type"} eq "del") {
+        push @parents, $cur->param("parent")
+            if !$cur->param("hid");
+    }
+    
+    # Nothing to rebuild
+    return if @parents == 0 && !$build_myself;
+    
+    # Compose the SQL statement
+    @_ = qw();
+    push @_, "sn=" . $self->{"sn"} if $build_myself;
+    foreach (@parents) {
+        # The parent page and those share the same parent
+        if (defined $_) {
+            push @_, "sn=" . $_;
+            push @_, "parent=" . $_;
+        # The topmost pages
+        } else {
+            push @_, "parent IS NULL";
+        }
+    }
+    $cond = join " OR ", @_;
+    $cond = "($cond)" if @_ > 1;
+    @_ = $DBH->cols($self->{"table"});
+    push @_, $DBH->strcat("'/links'", "linkcat_path(sn, id, parent)")
+      . " AS path";
+    $sql = "SELECT " . join(", ", @_) . " FROM " . $DBH->quote_identifier($self->{"table"})
+        . " WHERE $cond"
+        . " AND linkcat_isshown(sn, hid, parent);\n";
+    # Rebuild the pages
+    $_ = $MAIN->can("rebuild_links");
+    &$_($sql);
+    return;
+}
+
+# _remove_curfile: Remove the unwanted page
+sub _remove_curfile : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Remove the unwanted category files
+    %_ = map { $_ => 1 } @{${$self->{"newshown"}}{"catspath"}};
+    grmoldpage $_
+        foreach grep !exists $_{$_}, @{${$self->{"curshown"}}{"catspath"}};
+    return;
+}
+
+# _shown_parts: Obtain the shown parts
+sub _shown_parts : method {
+    local ($_, %_);
+    my ($self, $shown, $sql, $sth);
+    $self = $_[0];
+    $shown = links_shown_parts;
+    # Check if myself is shown
+    $sql = "SELECT sn FROM " . $DBH->quote_identifier($self->{"table"})
+        . " WHERE sn=" . $self->{"sn"}
+        . " AND linkcat_isshown(sn, hid, parent);\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    $$shown{"self"} = ($sth->rows > 0);
+    return $shown;
+}
+
+return 1;

lib/perl5/Selima/Processor/LinkCatz.pm

@@ -0,0 +1,198 @@
+# Selima Website Content Management System
+# LinkCatz.pm: The related-link category membership data processor.
+
+#  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-03-17
+
+package Selima::Processor::LinkCatz;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor::Categorz);
+
+use Selima::DataVars qw($DBH :addcol :scptconf);
+use Selima::Guest;
+use Selima::Links;
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "linkcatz" if @_ < 2;
+    $self = $class->SUPER::new(@_);
+    return $self;
+}
+
+# _save_cols: Save the column deposit
+sub _save_cols : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    if ($self->{"type"} eq "new") {
+        $self->{"sn"} = $self->_new_sn;
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_INSERT);
+        $self->{"cols"}->addnum("sn", $self->{"sn"});
+        $self->{"cols"}->addnum("cat", $self->_form("cat"));
+        $self->{"cols"}->addnum("link", $self->_form("link"));
+    
+    # A form to edit a current item
+    } elsif ($self->{"type"} eq "cur") {
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
+        $self->{"cols"}->addnum("cat", $self->_form("cat"), scalar $cur->param("cat"));
+        $self->{"cols"}->addnum("link", $self->_form("link"), scalar $cur->param("link"));
+    }
+    return;
+}
+
+# _actlog: Log the activity
+sub _actlog : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    return gactlog "Create a link categorization record " . link_url($form->param("link"))
+            . " in category " . linkcat_title($form->param("cat"))
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return gactlog "Update the link categorization record " . link_url($form->param("link"))
+            . " in category " . linkcat_title($form->param("cat"))
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return gactlog "Delete the link categorization record " . link_url($cur->param("link"))
+            . " in category " . linkcat_title($cur->param("cat"))
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "del";
+}
+
+# _rebuild_partial_pages: Rebuild a limited part of pages
+sub _rebuild_partial_pages : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    my ($sql, @parents, @cats, $cond);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    $self->{"newshown"} = $self->_shown_parts;
+    # Remove the unwanted pages
+    $self->_remove_curfile;
+    
+    # Find the affected parents
+    @parents = qw();
+    @_ = qw();
+    %_ = map { $_ => 1 } @{${$self->{"curshown"}}{"cats"}};
+    push @_, grep !exists $_{$_}, @{${$self->{"newshown"}}{"cats"}};
+    %_ = map { $_ => 1 } @{${$self->{"newshown"}}{"cats"}};
+    push @_, grep !exists $_{$_}, @{${$self->{"curshown"}}{"cats"}};
+    if (@_ > 0) {
+        my ($sql, $sth, $count, $row);
+        $sql = "SELECT parent FROM linkcat"
+            . " WHERE " . join(" OR ", map "sn=$_", @_)
+            . " GROUP BY parent;\n";
+        $sth = $DBH->prepare($sql);
+        $sth->execute;
+        $count = $sth->rows;
+        for ($_ = 0; $_ < $count; $_++) {
+            push @parents, ${$sth->fetch}[0];
+        }
+    }
+    
+    # Find the affected parts
+    # Only the shown parts are added
+    %_ = qw();
+    # A form to create a new item
+    if ($self->{"type"} eq "new") {
+        $_{$form->param("cat")} = 1;
+    # A form to edit a current item
+    } elsif ($self->{"type"} eq "cur") {
+        $_{$form->param("cat")} = 1;
+        $_{$cur->param("cat")} = 1;
+    # A form to delete a current item
+    } elsif ($self->{"type"} eq "del") {
+        $_{$cur->param("cat")} = 1;
+    }
+    @cats = keys %_;
+    # The statistics pages on their parents are affected
+    unless ($self->{"type"} eq "cur"
+            && $form->param("cat") == $cur->param("cat")) {
+        my ($sql, $sth, $count);
+        $_ = join(" OR ", map "sn=$_", @cats);
+        $_ = "($_)" if @_ > 1;
+        $sql = "SELECT parent FROM linkcat"
+            . " WHERE $_"
+            . " AND parent IS NOT NULL"
+            . " AND linkcat_isshown(sn, hid, parent)"
+            . " GROUP BY parent;\n";
+        $sth = $DBH->prepare($sql);
+        $sth->execute;
+        $count = $sth->rows;
+        for ($_ = 0; $_ < $count; $_++) {
+            push @cats, ${$sth->fetch}[0];
+        }
+    }
+    %_ = map { $_ => 1 } @cats;
+    @cats = keys %_;
+    
+    # Compose the SQL statement
+    @_ = qw();
+    push @_, "sn=" . $_ foreach @cats;
+    foreach (@parents) {
+        # The parent page and those share the same parent
+        if (defined $_) {
+            push @_, "sn=" . $_;
+            push @_, "parent=" . $_;
+        # The topmost pages
+        } else {
+            push @_, "parent IS NULL";
+        }
+    }
+    $cond = join " OR ", @_;
+    $cond = "($cond)" if @_ > 1;
+    @_ = $DBH->cols("linkcat");
+    push @_, $DBH->strcat("'/links'", "linkcat_path(sn, id, parent)")
+      . " AS path";
+    $sql = "SELECT " . join(", ", @_) . " FROM linkcat"
+        . " WHERE $cond"
+        . " AND linkcat_isshown(sn, hid, parent);\n";
+    # Rebuild the pages
+    $_ = $MAIN->can("rebuild_links");
+    &$_($sql);
+    return;
+}
+
+# _remove_curfile: Remove the unwanted page
+sub _remove_curfile : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Remove the unwanted category files
+    %_ = map { $_ => 1 } @{${$self->{"newshown"}}{"catspath"}};
+    grmoldpage $_
+        foreach grep !exists $_{$_}, @{${$self->{"curshown"}}{"catspath"}};
+    return;
+}
+
+# _shown_parts: Obtain the shown parts
+sub _shown_parts : method {
+    return links_shown_parts;
+}
+
+return 1;

lib/perl5/Selima/Processor/ListPref.pm

@@ -0,0 +1,157 @@
+# Selima Website Content Management System
+# ListPref.pm: The list preference data processor.
+
+#  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-03-22
+
+package Selima::Processor::ListPref;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor);
+
+use CGI;
+
+use Selima::DataVars qw($DBH :dataman :input);
+use Selima::Guest;
+use Selima::LogIn;
+use Selima::UserPref;
+
+# Load these classes
+use Selima::Processor::UserPref;
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $self = $class->SUPER::new(@_);
+    $self->{"is_sql"} = 0 if is_guest;
+    $self->{"names"} = [qw(listsize listcols)];
+    return $self;
+}
+
+# process: Process the form, fully
+sub process : method {
+    local ($_, %_);
+    my ($self, $form);
+    ($self, @_) = @_;
+    # Use the parent processor for ordinary users
+    return $self->SUPER::process(@_) unless is_guest;
+    
+    # Guest preferences are saved in $SESSION
+    $form = $self->{"form"};
+    $$SESSION{"userpref"} = {}
+        if !exists $$SESSION{"userpref"};
+    ${$$SESSION{"userpref"}}{$form->param("domain")} = {}
+        if !exists ${$$SESSION{"userpref"}}{$form->param("domain")};
+    $_ = ${$$SESSION{"userpref"}}{$form->param("domain")};
+    
+    foreach my $name (@{$self->{"names"}}) {
+        $$_{$name} = $form->param($name);
+    }
+    return;
+}
+
+# _save_cols: Save the column deposit
+sub _save_cols : method {
+    local ($_, %_);
+    my ($self, $form);
+    $self = $_[0];
+    $form = $self->{"form"};
+    
+    foreach my $name (@{$self->{"names"}}) {
+        my ($val, $sql, $sth, $row, $sn, $cols, $subform);
+        # Obtain the preference value
+        $val = $self->_prefval($name);
+        # Only update if value is different
+        $_ = userpref $name, $form->param("domain");
+        next if defined $_ && $_ eq $val;
+        
+        # Check if there is already an existing user preference
+        $sql = "SELECT * FROM userpref"
+            . " WHERE usr=" . get_login_sn
+            . " AND domain=" . $DBH->quote($form->param("domain"))
+            . " AND name=" . $DBH->quote($name) . ";\n";
+        $sth = $DBH->prepare($sql);
+        $sth->execute;
+        # There is an existing user preference
+        if ($sth->rows == 1) {
+            my ($subform, $cols, %CURRENT_SUP);
+            $row = $sth->fetchrow_hashref;
+            %CURRENT_SUP = %CURRENT;
+            %CURRENT = (
+                "sn"        => $$row{"sn"},
+                "usr"       => $$row{"usr"},
+                "domain"    => $$row{"domain"},
+                "name"      => $$row{"name"},
+                "value"     => $$row{"value"},
+            );
+            $subform = new CGI("");
+            $subform->param("form", "cur");
+            $subform->param("sn", $$row{"sn"});
+            $subform->param("usr", get_login_sn);
+            $subform->param("domain", $form->param("domain"));
+            $subform->param("name", $name);
+            $subform->param("value", $val);
+            $cols = new Selima::Processor::UserPref($subform);
+            $cols->_save_cols;
+            push @{$self->{"subs"}}, $cols;
+            %CURRENT = %CURRENT_SUP;
+        
+        # There is no existing user preference
+        } else {
+            my ($subform, $cols);
+            $subform = new CGI("");
+            $subform->param("form", "new");
+            $subform->param("usr", get_login_sn);
+            $subform->param("domain", $form->param("domain"));
+            $subform->param("name", $name);
+            $subform->param("value", $val);
+            $cols = new Selima::Processor::UserPref($subform);
+            $cols->_save_cols;
+            push @{$self->{"subs"}}, $cols;
+        }
+    }
+    return;
+}
+
+# _actlog: Log the activity
+sub _actlog : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Run the sub-processors
+    foreach (@{$self->{"subs"}}) {
+        $_->_actlog if $_->_modified;
+    }
+}
+
+# _prefval: Obtain the preference value
+sub _prefval : method {
+    local ($_, %_);
+    my ($self, $name);
+    ($self, $name) = @_;
+    # Specified
+    return $_ if defined($_ = $self->{"form"}->param($name));
+    # No need to check the validility.  Invalids are simply ignored.
+    @_ = grep s/^${name}_//, $self->{"form"}->param;
+    # Compose the preference value
+    return join " ", @_;
+}
+
+return 1;

lib/perl5/Selima/Processor/ListPref/AcctReps.pm

@@ -0,0 +1,37 @@
+# Selima Website Content Management System
+# AcctReps.pm: The accounting report list preference data processor.
+
+#  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-10-01
+
+package Selima::Processor::ListPref::AcctReps;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor::ListPref);
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $self = $class->SUPER::new(@_);
+    $self->{"names"} = [qw(listsize)];
+    return $self;
+}
+
+return 1;

lib/perl5/Selima/Processor/LogOut.pm

@@ -0,0 +1,71 @@
+# Selima Website Content Management System
+# LogOut.pm: The log-out processor.
+
+#  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-03-19
+
+package Selima::Processor::LogOut;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor);
+
+use Selima::ChkPriv;
+use Selima::Guest;
+use Selima::LogIn;
+use Selima::LogOut;
+use Selima::Logging;
+use Selima::ScptPriv;
+use Selima::ShortCut;
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $self = $class->SUPER::new(@_);
+    $self->{"sn"} = get_login_sn;
+    $self->{"is_sql"} = 0;
+    $self->{"modified"} = 1;
+    $self->{"is_admin"} = is_guest()? is_admin_script: is_admin;
+    return $self;
+}
+
+# _save_cols: Save the column deposit
+# Make it a null function
+sub _save_cols : method {}
+
+# _other_tasks: Perform tasks other than column updates
+sub _other_tasks : method {
+    $_[0]->{"userid"} = get_login_id;
+    logout;
+}
+
+# _actlog: Log the activity
+sub _actlog : method {
+    # Log the guest log out, too
+    return actlog "Log out with s/n " . $_[0]->{"sn"} . ".", $_[0]->{"userid"};
+}
+
+# _ret_status: Return the process status
+sub _ret_status : method {
+    return {"msg"=>N_("You have successfully logged out."),
+            "isform"=>0,
+            "is_admin"=>$_[0]->{"is_admin"}};
+}
+
+return 1;

lib/perl5/Selima/Processor/Page.pm

@@ -0,0 +1,157 @@
+# Selima Website Content Management System
+# Page.pm: The base web page form data processor.
+
+#  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-02
+
+package Selima::Processor::Page;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor);
+
+use Selima::DataVars qw(:addcol :scptconf);
+use Selima::Guest;
+use Selima::ShortCut;
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "pages" if @_ < 2;
+    $self = $class->SUPER::new(@_);
+    return $self;
+}
+
+# _save_cols: Save the column deposit
+sub _save_cols : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    if ($self->{"type"} eq "new") {
+        $self->{"sn"} = $self->_new_sn;
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_INSERT);
+        $self->{"cols"}->addnum("sn", $self->{"sn"});
+        $self->{"cols"}->addstr("path", $self->_form("path"));
+        $self->{"cols"}->addnum("ord", $self->_form("ord"));
+        $self->{"cols"}->addstr("title", $self->_form("title"));
+        $self->{"cols"}->addstr("body", $self->_form("body"));
+        $self->{"cols"}->addstr("kw", $self->_form("kw"));
+        $self->{"cols"}->addbool("html", $self->_form("html"));
+        $self->{"cols"}->addbool("hid", $self->_form("hid"));
+        # Automatic Traditional Chinese to Simplified Chinese conversion
+        $self->_zhsync;
+    
+    # A form to edit a current item
+    } elsif ($self->{"type"} eq "cur") {
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
+        $self->{"cols"}->addstr("path", $self->_form("path"), scalar $cur->param("path"));
+        $self->{"cols"}->addnum("ord", $self->_form("ord"), scalar $cur->param("ord"));
+        $self->{"cols"}->addstr("title", $self->_form("title"), scalar $cur->param("title"));
+        $self->{"cols"}->addstr("body", $self->_form("body"), scalar $cur->param("body"));
+        $self->{"cols"}->addstr("kw", $self->_form("kw"), scalar $cur->param("kw"));
+        $self->{"cols"}->addbool("html", $self->_form("html"), scalar $cur->param("html"));
+        $self->{"cols"}->addbool("hid", $self->_form("hid"), scalar $cur->param("hid"));
+        # Automatic Traditional Chinese to Simplified Chinese conversion
+        $self->_zhsync;
+    }
+    return;
+}
+
+# _actlog: Log the activity
+sub _actlog : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    return gactlog "Create a page " . $form->param("path")
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return gactlog "Update the page " . $form->param("path")
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return gactlog "Delete the page " . $cur->param("path")
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "del";
+}
+
+# _ret_status: Return the process status
+sub _ret_status : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    return {"msg"=>N_("This page was not modified."),
+            "isform"=>0}
+        if !$self->_modified;
+    # A form to create a new item
+    return {"msg"=>N_("This page has been successfully added."),
+            "isform"=>0}
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return {"msg"=>N_("This page has been successfully updated."),
+            "isform"=>0}
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return {"msg"=>N_("This page has been successfully deleted."),
+            "isform"=>0}
+        if $self->{"type"} eq "del";
+}
+
+# _rebuild_partial_pages: Rebuild a limited part of pages
+sub _rebuild_partial_pages : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    my $sql;
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # Remove the unwanted pages
+    $self->_remove_curfile;
+    # Nothing to rebuild when no shown parts are seen
+    return if $self->{"type"} eq "del" || defined $form->param("hid");
+    
+    # Compose the SQL statement
+    $sql = "SELECT * FROM pages"
+        . " WHERE sn=" . $self->{"sn"} . ";\n";
+    # Rebuild the pages
+    $_ = $MAIN->can("rebuild_pages");
+    &$_($sql);
+    return;
+}
+
+# _remove_curfile: Remove the unwanted pages
+sub _remove_curfile : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # Nothing to remove if there is no current page
+    return if $self->{"type"} eq "new" || $cur->param("hid");
+    # A current page to be deleted or hidden
+    return grmoldpage $cur->param("path")
+        if $self->{"type"} eq "del" || defined $form->param("hid");
+    # A shown page update with a new page path to check with
+    return grmoldpage $cur->param("path"), $form->param("path");
+    return;
+}
+
+return 1;

lib/perl5/Selima/Processor/Rebuild.pm

@@ -0,0 +1,66 @@
+# Selima Website Content Management System
+# Rebuild.pm: The web page rebuild processor.
+
+#  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::Processor::Rebuild;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor);
+
+use Time::HiRes qw();
+
+use Selima::DataVars qw(:scptconf);
+use Selima::Guest;
+use Selima::ShortCut;
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $self = $class->SUPER::new(@_);
+    $self->{"modified"} = 1;
+    return $self;
+}
+
+# _other_tasks: Perform tasks other than column updates
+sub _other_tasks : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # Rebuild the pages
+    $self->{"t_start"} = Time::HiRes::time;
+    $_ = $MAIN->can("rebuild_" . $self->{"form"}->param("type"));
+    &$_();
+    $self->{"t_end"} = Time::HiRes::time;
+}
+
+# _actlog: Log the activity
+sub _actlog : method {
+    return gactlog "Rebuild pages of type \"" . $_[0]->{"form"}->param("type") . "\".";
+}
+
+# _ret_status: Return the process status
+sub _ret_status : method {
+    return {"msg"=>N_("The specified web pages have been successfully rebuilt.  ([sprintf,%0.3f,_1] seconds)"),
+            "margs"=>[$_[0]->{"t_end"}-$_[0]->{"t_start"}]};
+}
+
+return 1;

lib/perl5/Selima/Processor/ScptPriv.pm

@@ -0,0 +1,110 @@
+# Selima Website Content Management System
+# ScptPriv.pm: The script privilege data processor.
+
+#  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-03-17
+
+package Selima::Processor::ScptPriv;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor);
+
+use Selima::DataVars qw(:addcol);
+use Selima::Guest;
+use Selima::ShortCut;
+use Selima::UserName;
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "scptpriv" if @_ < 2;
+    $self = $class->SUPER::new(@_);
+    return $self;
+}
+
+# _save_cols: Save the column deposit
+sub _save_cols : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    if ($self->{"type"} eq "new") {
+        $self->{"sn"} = $self->_new_sn;
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_INSERT);
+        $self->{"cols"}->addnum("sn", $self->{"sn"});
+        $self->{"cols"}->addstr("script", $self->_form("script"));
+        $self->{"cols"}->addnum("grp", $self->_form("grp"));
+    
+    # A form to edit a current item
+    } elsif ($self->{"type"} eq "cur") {
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
+        $self->{"cols"}->addstr("script", $self->_form("script"), scalar $cur->param("script"));
+        $self->{"cols"}->addnum("grp", $self->_form("grp"), scalar $cur->param("grp"));
+    }
+    return;
+}
+
+# _actlog: Log the activity
+sub _actlog : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    return gactlog "Create a script privilege record " . $form->param("script")
+            . " for group " . groupid($form->param("grp"))
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return gactlog "Update the script privilege record " . $form->param("script")
+            . " for group " . groupid($form->param("grp"))
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return gactlog "Delete the script privilege record " . $cur->param("script")
+            . " for group " . groupid($cur->param("grp"))
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "del";
+}
+
+# _ret_status: Return the process status
+sub _ret_status : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    return {"msg"=>N_("This script privilege record was not modified."),
+            "isform"=>0}
+        if !$self->_modified;
+    # A form to create a new item
+    return {"msg"=>N_("This script privilege record has been successfully added."),
+            "isform"=>0}
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return {"msg"=>N_("This script privilege record has been successfully updated."),
+            "isform"=>0}
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return {"msg"=>N_("This script privilege record has been successfully deleted."),
+            "isform"=>0}
+        if $self->{"type"} eq "del";
+}
+
+return 1;

lib/perl5/Selima/Processor/User.pm

@@ -0,0 +1,238 @@
+# Selima Website Content Management System
+# User.pm: The user account data processor.
+
+#  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-03-17
+
+package Selima::Processor::User;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor);
+
+use CGI;
+
+use Selima::ChkPriv;
+use Selima::DataVars qw(:addcol :groups);
+use Selima::Guest;
+use Selima::LogIn;
+use Selima::ShortCut;
+use Selima::UserName;
+
+use Selima::Processor::UserMem;
+use Selima::Processor::Deletion;
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "users" if @_ < 2;
+    $self = $class->SUPER::new(@_);
+    $self->{"is_self"} = 0;
+    $self->{"no_set_groups"} = 0;
+    # Non-super-users editing herself are not allowed to update the groups
+    $self->{"no_set_groups"} = 1
+        if exists $self->{"sn"} && !is_su && $self->{"sn"} == get_login_sn;
+    return $self;
+}
+
+# _save_cols: Save the column deposit
+sub _save_cols : method {
+    local ($_, %_);
+    my ($self, $form, $cur, @olditems, @newitems, @additems, @delitems, $passwd);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    if ($self->{"type"} eq "new") {
+        # Set a dummy password for guests
+        $self->{"sn"} = $self->_new_sn;
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_INSERT);
+        $self->{"cols"}->{"login"} = $self->{"sn"}
+            if $self->{"is_self"} && !defined get_login_sn;
+        $self->{"cols"}->addnum("sn", $self->{"sn"});
+        $self->{"cols"}->addstr("id", $self->_form("id"));
+        $self->{"cols"}->addpass("passwd", $self->_purge_passwd, $self->_form("passwd"));
+        $self->{"cols"}->addstr("name", $self->_form("name"));
+        $self->{"cols"}->addbool("disabled", $self->_form("disabled"));
+        
+        # Find the changed items
+        unless ($self->{"no_set_groups"}) {
+            @additems = qw();
+            for ($_ = 0; defined $form->param("supgroup$_" . "sn"); $_++) {
+                push @additems, $form->param("supgroup$_" . "sn")
+                    if defined $form->param("supgroup$_");
+            }
+            # Super users can set the super-user privilege
+            if (is_su) {
+                # Super user privilege is added
+                push @additems, su_group_sn
+                    if defined $form->param("su");
+            }
+            foreach my $item (@additems) {
+                my ($subform, $cols);
+                $subform = new CGI("");
+                $subform->param("form", "new");
+                $subform->param("grp", $item);
+                $subform->param("member", $self->{"sn"});
+                $cols = new Selima::Processor::UserMem($subform);
+                $cols->_save_cols;
+                push @{$self->{"subs"}}, $cols;
+            }
+        }
+    
+    # A form to edit a current item
+    } elsif ($self->{"type"} eq "cur") {
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
+        $self->{"cols"}->{"login"} = $self->{"sn"}
+            if $self->{"is_self"} && !defined get_login_sn;
+        # Skip for non-super-user editing a super-user
+        unless (!is_su && $cur->param("su")) {
+            $self->{"cols"}->addstr("id", $self->_form("id"), scalar $cur->param("id"));
+            $self->{"cols"}->addpass("passwd", $self->_purge_passwd, $self->_form("passwd"), scalar $cur->param("passwd"));
+        }
+        $self->{"cols"}->addstr("name", $self->_form("name"), scalar $cur->param("name"));
+        # Skip for non-super-user editing herself or a super-user
+        unless (!is_su && ($cur->param("su") || $self->{"sn"} == get_login_sn)) {
+            $self->{"cols"}->addbool("disabled", $self->_form("disabled"), scalar $cur->param("disabled"));
+        }
+        
+        # Find the changed items
+        unless ($self->{"no_set_groups"}) {
+            @olditems = qw();
+            @newitems = qw();
+            for ($_ = 0; $_ < $cur->param("supgroupcount"); $_++) {
+                push @olditems, $cur->param("supgroup$_" . "sn");
+            }
+            for ($_ = 0; defined $form->param("supgroup$_" . "sn"); $_++) {
+                push @newitems, $form->param("supgroup$_" . "sn")
+                    if defined $form->param("supgroup$_");
+            }
+            %_ = map { $_ => 1 } @newitems;
+            @delitems = grep !exists $_{$_}, @olditems;
+            %_ = map { $_ => 1 } @olditems;
+            @additems = grep !exists $_{$_}, @newitems;
+            # Super users can set the super-user privilege
+            if (is_su) {
+                # Super user privilege is added
+                if (!$cur->param("su") && defined $form->param("su")) {
+                    push @additems, su_group_sn;
+                # Super user privilege is removed
+                } elsif ($cur->param("su") && !defined $form->param("su")) {
+                    push @delitems, su_group_sn;
+                }
+            }
+            foreach my $item (@additems) {
+                my ($subform, $cols);
+                $subform = new CGI("");
+                $subform->param("form", "new");
+                $subform->param("grp", $item);
+                $subform->param("member", $self->{"sn"});
+                $cols = new Selima::Processor::UserMem($subform);
+                $cols->_save_cols;
+                push @{$self->{"subs"}}, $cols;
+            }
+            if (@delitems > 0) {
+                my $subform;
+                @_ = map "grp=$_", @delitems;
+                $_ = (scalar(@_) == 1)? $_[0]: "(" . join(" OR ", @_) . ")";
+                $subform = new CGI("");
+                $subform->param("cond", "$_ AND member=" . $self->{"sn"});
+                push @{$self->{"subs"}}, new Selima::Processor::Deletion($subform, "usermem");
+            }
+        }
+    
+    # A form to delete a current item
+    } elsif ($self->{"type"} eq "del") {
+        # Find the changed items
+        $_ = new CGI("");
+        $_->param("cond", "member=" . $self->{"sn"});
+        push @{$self->{"subs"}}, new Selima::Processor::Deletion($_, "usermem");
+        
+        $_ = new CGI("");
+        $_->param("cond", "usr=" . $self->{"sn"});
+        push @{$self->{"subs"}}, new Selima::Processor::Deletion($_, "userpref");
+    }
+    return;
+}
+
+# _actlog: Log the activity
+sub _actlog : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    return gactlog "Create a user account " . $form->param("id")
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return gactlog "Update the user account "
+            . (defined $form->param("id")? $form->param("id"): $cur->param("id"))
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return gactlog "Delete the user account " . $cur->param("id")
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "del";
+}
+
+# _ret_status: Return the process status
+sub _ret_status : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    return {"msg"=>N_("This user account was not modified."),
+            "isform"=>0}
+        if !$self->_modified;
+    # A form to create a new item
+    return {"msg"=>N_("This user account has been successfully added."),
+            "isform"=>0}
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return {"msg"=>N_("This user account has been successfully updated."),
+            "isform"=>0}
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return {"msg"=>N_("This user account has been successfully deleted."),
+            "isform"=>0}
+        if $self->{"type"} eq "del";
+}
+
+# _purge_passwd: If we need to purge the password of the user
+sub _purge_passwd : method {
+    local ($_, %_);
+    my ($self, $form);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Checked before
+    return $self->{"purge_passwd"} if exists $self->{"purge_passwd"};
+    # Purge password for guests
+    unless ($self->{"no_set_groups"}) {
+        for ($_ = 0; defined $form->param("supgroup$_" . "sn"); $_++) {
+            # Skip unselected groups
+            next unless defined $form->param("supgroup$_");
+            # Check if this is the guest group
+            return ($self->{"purge_passwd"} = 1)
+                if groupid($form->param("supgroup$_" . "sn")) eq GUEST_GROUP;
+        }
+    }
+    # No guest group was found
+    return ($self->{"purge_passwd"} = 0);
+}
+
+return 1;

lib/perl5/Selima/Processor/UserMem.pm

@@ -0,0 +1,110 @@
+# Selima Website Content Management System
+# UserMem.pm: The user-to-group membership data processor.
+
+#  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-03-17
+
+package Selima::Processor::UserMem;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor);
+
+use Selima::DataVars qw(:addcol);
+use Selima::Guest;
+use Selima::ShortCut;
+use Selima::UserName;
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "usermem" if @_ < 2;
+    $self = $class->SUPER::new(@_);
+    return $self;
+}
+
+# _save_cols: Save the column deposit
+sub _save_cols : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    if ($self->{"type"} eq "new") {
+        $self->{"sn"} = $self->_new_sn;
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_INSERT);
+        $self->{"cols"}->addnum("sn", $self->{"sn"});
+        $self->{"cols"}->addnum("grp", $self->_form("grp"));
+        $self->{"cols"}->addnum("member", $self->_form("member"));
+    
+    # A form to edit a current item
+    } elsif ($self->{"type"} eq "cur") {
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
+        $self->{"cols"}->addnum("grp", $self->_form("grp"), scalar $cur->param("grp"));
+        $self->{"cols"}->addnum("member", $self->_form("member"), scalar $cur->param("member"));
+    }
+    return;
+}
+
+# _actlog: Log the activity
+sub _actlog : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    return gactlog "Create a user membership " . userid($form->param("member"))
+            . " in group " . groupid($form->param("grp"))
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return gactlog "Update the user membership " . userid($form->param("member"))
+            . " in group " . groupid($form->param("grp"))
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return gactlog "Delete the user membership " . userid($cur->param("member"))
+            . " in group " . groupid($cur->param("grp"))
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "del";
+}
+
+# _ret_status: Return the process status
+sub _ret_status : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    return {"msg"=>N_("This user membership record was not modified."),
+            "isform"=>0}
+        if !$self->_modified;
+    # A form to create a new item
+    return {"msg"=>N_("This user membership record has been successfully added."),
+            "isform"=>0}
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return {"msg"=>N_("This user membership record has been successfully updated."),
+            "isform"=>0}
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return {"msg"=>N_("This user membership record has been successfully deleted."),
+            "isform"=>0}
+        if $self->{"type"} eq "del";
+}
+
+return 1;

lib/perl5/Selima/Processor/UserPref.pm

@@ -0,0 +1,159 @@
+# Selima Website Content Management System
+# UserPref.pm: The user preference data processor.
+
+#  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-03-17
+
+package Selima::Processor::UserPref;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor);
+
+use Selima::DataVars qw(:addcol);
+use Selima::Guest;
+use Selima::ShortCut;
+use Selima::UserName;
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "userpref" if @_ < 2;
+    $self = $class->SUPER::new(@_);
+    return $self;
+}
+
+# _save_cols: Save the column deposit
+sub _save_cols : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    if ($self->{"type"} ne "del") {
+        # Set the "everyone" user
+        $form->delete("usr") if     defined $form->param("everyone")
+                                    && $form->param("everyone") eq "true";
+        # Set the "everywhere" domain
+        $form->delete("domain") if  defined $form->param("everywhere")
+                                    && $form->param("everywhere") eq "true";
+    }
+    # A form to create a new item
+    if ($self->{"type"} eq "new") {
+        $self->{"sn"} = $self->_new_sn;
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_INSERT);
+        $self->{"cols"}->addnum("sn", $self->{"sn"});
+        $self->{"cols"}->addnum("usr", $self->_form("usr"));
+        $self->{"cols"}->addstr("domain", $self->_form("domain"));
+        $self->{"cols"}->addstr("name", $self->_form("name"));
+        $self->{"cols"}->addstr_empty("value", $self->_form("value"));
+    
+    # A form to edit a current item
+    } elsif ($self->{"type"} eq "cur") {
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
+        $self->{"cols"}->addnum("usr", $self->_form("usr"), scalar $cur->param("usr"));
+        $self->{"cols"}->addstr("domain", $self->_form("domain"), scalar $cur->param("domain"));
+        $self->{"cols"}->addstr("name", $self->_form("name"), scalar $cur->param("name"));
+        $self->{"cols"}->addstr_empty("value", $self->_form("value"), scalar $cur->param("value"));
+    }
+    return;
+}
+
+# _actlog: Log the activity
+sub _actlog : method {
+    local ($_, %_);
+    my ($self, $form, $cur, $user, $domain);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    if ($self->{"type"} eq "new") {
+        if (    defined $form->param("everyone")
+                && $form->param("everyone") eq "true") {
+            $user = "everyone";
+        } elsif (!defined $form->param("usr")) {
+            $user = "everyone";
+        } else {
+            $user = userid $form->param("usr");
+        }
+        if (    defined $form->param("everywhere")
+                && $form->param("everywhere") eq "true") {
+            $domain = "everywhere";
+        } elsif (!defined $form->param("domain")) {
+            $domain = "everywhere";
+        } else {
+            $domain = $form->param("domain");
+        }
+        return gactlog "Create a user preference \"" . $form->param("name") . "\""
+                . " of $user for $domain"
+                . " with s/n " . $self->{"sn"} . ".";
+    # A form to edit a current item
+    } elsif ($self->{"type"} eq "cur") {
+        if (    defined $form->param("everyone")
+                && $form->param("everyone") eq "true") {
+            $user = "everyone";
+        } elsif (!defined $form->param("usr")) {
+            $user = "everyone";
+        } else {
+            $user = userid $form->param("usr");
+        }
+        if (    defined $form->param("everywhere")
+                && $form->param("everywhere") eq "true") {
+            $domain = "everywhere";
+        } elsif (!defined $form->param("domain")) {
+            $domain = "everywhere";
+        } else {
+            $domain = $form->param("domain");
+        }
+        return gactlog "Update the user preference \"" . $form->param("name") . "\""
+                . " of $user for $domain"
+                . " with s/n " . $self->{"sn"} . ".";
+    # A form to delete a current item
+    } elsif ($self->{"type"} eq "del") {
+        $user = defined $cur->param("usr")?
+            userid $cur->param("usr"): "everyone";
+        $domain = defined $cur->param("domain")?
+            $cur->param("domain"): "everywhere";
+        return gactlog "Delete the user preference \"" . $cur->param("name") . "\""
+                . " of $user for $domain"
+                . " with s/n " . $self->{"sn"} . ".";
+    }
+}
+
+# _ret_status: Return the process status
+sub _ret_status : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    return {"msg"=>N_("This user preference was not modified."),
+            "isform"=>0}
+        if !$self->_modified;
+    # A form to create a new item
+    return {"msg"=>N_("This user preference has been successfully added."),
+            "isform"=>0}
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return {"msg"=>N_("This user preference has been successfully updated."),
+            "isform"=>0}
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return {"msg"=>N_("This user preference has been successfully deleted."),
+            "isform"=>0}
+        if $self->{"type"} eq "del";
+}
+
+return 1;