Initial commit.

htdocs/htc/magicat/cgi-bin/actlog.cgi

@@ -0,0 +1,51 @@
+#! /usr/bin/perl -w
+# History: Theory and Culture
+# actlog.cgi: The activity log viewer.
+
+#  Copyright (c) 2005-2021 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2005-05-10
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::htc;
+local $SIG{"__DIE__"} = \&http_500;
+my $d = new Selima::Destroy;
+# Prototype declaration
+sub main();
+
+initenv(-restricted => 1,
+        -allowed    => [qw(GET HEAD)],
+        -lastmod    => 0,
+        -lmfiles    => [$ACTLOG],
+        -page_param => {"keywords"              => N_("activity, logs")});
+
+main;
+exit 0;
+
+sub main() {
+    local ($_, %_);
+    my $LIST;
+    # List handler handles its own error
+    $LIST = new Selima::List::ActLog;
+    html_header $LIST->{"title"};
+    html_errmsg retrieve_status;
+    $LIST->html;
+    html_footer;
+    return;
+}

htdocs/htc/magicat/cgi-bin/groupmem.cgi

@@ -0,0 +1,236 @@
+#! /usr/bin/perl -w
+# History: Theory and Culture
+# groupmem.cgi: The group-to-group membership administration.
+
+#  Copyright (c) 2004-2021 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2004-10-16
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::htc;
+local $SIG{"__DIE__"} = \&http_500;
+my $d = new Selima::Destroy;
+# Prototype declaration
+sub main();
+sub check_get();
+sub check_post();
+sub html_page($);
+sub fetch_curitem();
+sub import_selgrp($);
+sub import_selmember($);
+
+initenv(-restricted => 1,
+        -this_table => "groupmem",
+        -dbi_lock   => {"groupmem"              => LOCK_EX,
+                        "groups"                => LOCK_SH,
+                        "groups AS grpmembers"  => LOCK_SH},
+        -lastmod    => 1,
+        -page_param => {"keywords"              => N_("group membership")});
+
+main;
+exit 0;
+
+sub main() {
+    local ($_, %_);
+    my ($error, $success, $processor);
+    
+    # If the request is a GET query
+    if ($ENV{"REQUEST_METHOD"} ne "POST") {
+        $error = check_get;
+        # If an error occurs
+        if (defined $error) {
+            html_page $error;
+        
+        # Display the page
+        } else {
+            html_page retrieve_status;
+        }
+    
+    # If a form was POSTed from the client
+    } else {
+        $error = check_post;
+        # If an error occurs
+        if (defined $error) {
+            error_redirect $error;
+        
+        # Else, save the data
+        } else {
+            $processor = new Selima::Processor::GroupMem($POST);
+            $success = $processor->process;
+            success_redirect $success;
+        }
+    }
+    return;
+}
+
+# check_get: Check the GET arguments
+sub check_get() {
+    local ($_, %_);
+    my $error;
+    
+    # A form is requested
+    if (is_form) {
+        $_ = form_type;
+        # A form to create a new item
+        if ($_ eq "new") {
+            # Nothing to check on a new form
+        
+        # A form to edit a current item
+        } elsif ($_ eq "cur") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # A form to delete a current item
+        } elsif ($_ eq "del") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # Not a valid form
+        } else {
+            return {"msg"=>N_("Incorrect form: [_1]."),
+                    "margs"=>[$_],
+                    "isform"=>0};
+        }
+    }
+    # List handler handles its own error
+    # OK
+    return;
+}
+
+# check_post: Check the POSTed form
+sub check_post() {
+    local ($_, %_);
+    my ($checker, $error);
+    $_ = form_type;
+    # A form to create a new item
+    if ($_ eq "new") {
+        # Run the checker
+        $checker = new Selima::Checker::GroupMem(curform);
+        $checker->redir(qw(selgrp delgrp selmember delmember));
+        $error = $checker->check(qw(grp member));
+        return $error if defined $error;
+    
+    # A form to edit a current item
+    } elsif ($_ eq "cur") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;
+        # Run the checker
+        $checker = new Selima::Checker::GroupMem(curform);
+        $checker->redir(qw(del selgrp delgrp selmember delmember));
+        $error = $checker->check(qw(grp member));
+        return $error if defined $error;
+    
+    # A form to delete a current item
+    } elsif ($_ eq "del") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;;
+        # Run the checker
+        $checker = new Selima::Checker::GroupMem(curform);
+        $checker->redir(qw(cancel));
+    
+    # Not a valid form
+    } else {
+        return {"msg"=>N_("Incorrect form: [_1]."),
+                "margs"=>[$_],
+                "isform"=>0};
+    }
+    # OK
+    return;
+}
+
+# html_page: Display the page
+sub html_page($) {
+    local ($_, %_);
+    my ($status, $LIST, $FORM);
+    $status = $_[0];
+    # A form is requested
+    if (is_form $status) {
+        $FORM = new Selima::Form::GroupMem($status);
+        html_header $FORM->{"title"};
+        html_errmsg $status;
+        $FORM->html;
+        html_footer;
+    
+    # List the available items
+    } else {
+        $LIST = new Selima::List::GroupMem;
+        html_header $LIST->{"title"}, $LIST->page_param;
+        html_errmsg $status;
+        $LIST->html;
+        html_footer;
+    }
+    return;
+}
+
+
+##################################
+# Subroutines to manage the data #
+##################################
+# fetch_curitem: Fetch the current item
+sub fetch_curitem() {
+    local ($_, %_);
+    my ($sn, $FORM);
+    
+    # Return if fetched before
+    return if scalar(keys %CURRENT) > 0;
+    
+    # Obtain the current form
+    $FORM = curform;
+    # No item specified
+    return {"msg"=>N_("Please select the membership record."),
+            "isform"=>0}
+        if !defined $FORM->param("sn");
+    $sn = $FORM->param("sn");
+    
+    # Find the record
+    %CURRENT = fetchrec $sn, $THIS_TABLE;
+    # If this record exist
+    return {"msg"=>N_("This membership record does not exist anymore.  Please select another one."),
+            "isform"=>0}
+        if scalar(keys %CURRENT) == 0;
+    
+    # OK
+    return;
+}
+
+# import_selgrp: Import the selected group into the retrieved form
+sub import_selgrp($) {
+    local ($_, %_);
+    my $FORM;
+    $FORM = $_[0];
+    $FORM->param("grp", $GET->param("selsn"))
+        if  defined $GET->param("selsn")
+            && check_sn_in ${$GET->param_fetch("selsn")}[0], "groups";
+    return;
+}
+
+# import_selmember: Import the selected member into the retrieved form
+sub import_selmember($) {
+    local ($_, %_);
+    my $FORM;
+    $FORM = $_[0];
+    $FORM->param("member", $GET->param("selsn"))
+        if  defined $GET->param("selsn")
+            && check_sn_in ${$GET->param_fetch("selsn")}[0], "groups AS grpmembers";
+    return $FORM;
+}

htdocs/htc/magicat/cgi-bin/groups.cgi

@@ -0,0 +1,357 @@
+#! /usr/bin/perl -w
+# History: Theory and Culture
+# groups.cgi: The account group administration.
+
+#  Copyright (c) 2004-2021 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2004-10-16
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::htc;
+local $SIG{"__DIE__"} = \&http_500;
+my $d = new Selima::Destroy;
+# Prototype declaration
+sub main();
+sub check_get();
+sub check_post();
+sub html_page($);
+sub fetch_curitem();
+sub import_selsubuser($);
+sub import_selsubgroup($);
+sub import_selsupgroup($);
+
+initenv(-restricted => 1,
+        -this_table => "groups",
+        -dbi_lock   => {"groups"                => LOCK_EX,
+                        "usermem"               => LOCK_EX,
+                        "groupmem"              => LOCK_EX,
+                        "users"                 => LOCK_SH,
+                        "users AS members"      => LOCK_SH,
+                        "groups AS members"     => LOCK_SH},
+        -lastmod    => 1,
+        -page_param => {"keywords"              => N_("groups")});
+
+main;
+exit 0;
+
+sub main() {
+    local ($_, %_);
+    my ($error, $success, $processor);
+    
+    # If the request is a GET query
+    if ($ENV{"REQUEST_METHOD"} ne "POST") {
+        $error = check_get;
+        # If an error occurs
+        if (defined $error) {
+            html_page $error;
+        
+        # Display the page
+        } else {
+            html_page retrieve_status;
+        }
+    
+    # If a form was POSTed from the client
+    } else {
+        $error = check_post;
+        # If an error occurs
+        if (defined $error) {
+            error_redirect $error;
+        
+        # Else, save the data
+        } else {
+            $processor = new Selima::Processor::Group($POST);
+            $success = $processor->process;
+            success_redirect $success;
+        }
+    }
+    return;
+}
+
+# check_get: Check the GET arguments
+sub check_get() {
+    local ($_, %_);
+    my ($error, $FORM, $sn);
+    
+    # A form is requested
+    if (is_form) {
+        $_ = form_type;
+        # A form to create a new item
+        if ($_ eq "new") {
+            # Nothing to check on a new form
+        
+        # A form to edit a current item
+        } elsif ($_ eq "cur") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # A form to delete a current item
+        } elsif ($_ eq "del") {
+            # Check the privilege to manage this table
+            $FORM = curform;
+            $sn = defined $FORM->param("sn")? $FORM->param("sn"): -1;
+            unauth if !is_su && $sn == su_group_sn;
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # Not a valid form
+        } else {
+            return {"msg"=>N_("Incorrect form: [_1]."),
+                    "margs"=>[$_],
+                    "isform"=>0};
+        }
+    }
+    # List handler handles its own error
+    # OK
+    return;
+}
+
+# check_post: Check the POSTed form
+sub check_post() {
+    local ($_, %_);
+    my ($checker, $error, $FORM, $sn);
+    $_ = form_type;
+    # A form to create a new item
+    if ($_ eq "new") {
+        # Run the checker
+        $checker = new Selima::Checker::Group(curform);
+        $checker->redir(qw(selsubuser selsubgroup selsupgroup));
+        $error = $checker->check(qw(id dsc subuser subgroup supgroup));
+        return $error if defined $error;
+    
+    # A form to edit a current item
+    } elsif ($_ eq "cur") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;
+        # Run the checker
+        $checker = new Selima::Checker::Group(curform);
+        $checker->redir(qw(del selsubuser selsubgroup selsupgroup));
+        $error = $checker->check(qw(id dsc subuser subgroup supgroup));
+        return $error if defined $error;
+    
+    # A form to delete a current item
+    } elsif ($_ eq "del") {
+        # Check the privilege to manage this table
+        $FORM = curform;
+        $sn = defined $FORM->param("sn")? $FORM->param("sn"): -1;
+        unauth if !is_su && $sn == su_group_sn;
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;
+        # Run the checker
+        $checker = new Selima::Checker::Group(curform);
+        $checker->redir(qw(cancel));
+    
+    # Not a valid form
+    } else {
+        return {"msg"=>N_("Incorrect form: [_1]."),
+                "margs"=>[$_],
+                "isform"=>0};
+    }
+    # OK
+    return;
+}
+
+# html_page: Display the page
+sub html_page($) {
+    local ($_, %_);
+    my ($status, $LIST, $FORM);
+    $status = $_[0];
+    # A form is requested
+    if (is_form $status) {
+        $FORM = new Selima::Form::Group($status);
+        html_header $FORM->{"title"};
+        html_errmsg $status;
+        $FORM->html;
+        html_footer;
+    
+    # List the available items
+    } else {
+        $LIST = new Selima::List::Groups;
+        html_header $LIST->{"title"}, $LIST->page_param;
+        html_errmsg $status;
+        $LIST->html;
+        html_footer;
+    }
+    return;
+}
+
+
+##################################
+# Subroutines to manage the data #
+##################################
+# fetch_curitem: Fetch the current item
+sub fetch_curitem() {
+    local ($_, %_);
+    my ($sn, $FORM, $sth, $sql, $row, $title);
+    
+    # Return if fetched before
+    return if scalar(keys %CURRENT) > 0;
+    
+    # Obtain the current form
+    $FORM = curform;
+    # No item specified
+    return {"msg"=>N_("Please select the group."),
+            "isform"=>0}
+        if !defined $FORM->param("sn");
+    $sn = $FORM->param("sn");
+    
+    # Find the record
+    %CURRENT = fetchrec $sn, $THIS_TABLE;
+    # If this record exist
+    return {"msg"=>N_("This group does not exist anymore.  Please select another one."),
+            "isform"=>0}
+        if scalar(keys %CURRENT) == 0;
+    
+    # Obtain the user members list
+    $title = $DBH->strcat("users.id", "' ('", "users.name", "')'");
+    $sql = "SELECT users.sn AS sn,"
+        . " $title AS title"
+        . " FROM usermem"
+        . " INNER JOIN users ON usermem.member=users.sn"
+        . " WHERE usermem.grp=$sn"
+        . " ORDER BY users.id;\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    $CURRENT{"subusercount"} = $sth->rows;
+    for ($_ = 0; $_ < $CURRENT{"subusercount"}; $_++) {
+        $row = $sth->fetchrow_hashref;
+        $CURRENT{"subuser$_"} = 1;
+        $CURRENT{"subuser$_" . "sn"} = $$row{"sn"};
+        $CURRENT{"subuser$_" . "title"} = $$row{"title"};
+    }
+    
+    # Obtain the group members list
+    $sql = "SELECT groups.sn AS sn,"
+        . " groups.dsc AS title FROM groupmem"
+        . " INNER JOIN groups ON groupmem.member=groups.sn"
+        . " WHERE groupmem.grp=$sn"
+        . " ORDER BY groups.id;\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    $CURRENT{"subgroupcount"} = $sth->rows;
+    for ($_ = 0; $_ < $CURRENT{"subgroupcount"}; $_++) {
+        $row = $sth->fetchrow_hashref;
+        $CURRENT{"subgroup$_"} = 1;
+        $CURRENT{"subgroup$_" . "sn"} = $$row{"sn"};
+        $CURRENT{"subgroup$_" . "title"} = $$row{"title"};
+    }
+    
+    # Obtain the belonging groups list
+    $sql = "SELECT groups.sn AS sn,"
+        . " groups.dsc AS title FROM groupmem"
+        . " INNER JOIN groups ON groupmem.grp=groups.sn"
+        . " WHERE groupmem.member=$sn"
+        . " ORDER BY groups.id;\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    $CURRENT{"supgroupcount"} = $sth->rows;
+    for ($_ = 0; $_ < $CURRENT{"supgroupcount"}; $_++) {
+        $row = $sth->fetchrow_hashref;
+        $CURRENT{"supgroup$_"} = 1;
+        $CURRENT{"supgroup$_" . "sn"} = $$row{"sn"};
+        $CURRENT{"supgroup$_" . "title"} = $$row{"title"};
+    }
+    
+    # OK
+    return;
+}
+
+# import_selsubuser: Import the selected user into the retrieved form
+sub import_selsubuser($) {
+    local ($_, %_);
+    my $FORM;
+    $FORM = $_[0];
+    # Sanity checks
+    if (    defined $GET->param("selsn")
+            && check_sn_in ${$GET->param_fetch("selsn")}[0], "users AS members") {
+        # Get the current member list
+        %_ = map { $FORM->param($_) => 1 } grep /^subuser\d+sn$/, $FORM->param;
+        $_{$GET->param("selsn")} = 1;
+        @_ = sort { userid $a cmp userid $b } keys %_;
+        # Get the checked member list
+        %_ = map { $FORM->param($_ . "sn") => 1 }
+            grep /^subuser\d+$/ && defined $FORM->param($_ . "sn"), $FORM->param;
+        $_{$GET->param("selsn")} = 1;
+        # Remove the old values
+        $FORM->delete(grep /^subuser\d+/, $FORM->param);
+        # Add the current values
+        for ($_ = 0; $_ < @_; $_++) {
+            $FORM->param("subuser$_" . "sn", $_[$_]);
+            $FORM->param("subuser$_", 1) if exists $_{$_[$_]};
+        }
+    }
+    return;
+}
+
+# import_selsubgroup: Import the selected user into the retrieved form
+sub import_selsubgroup($) {
+    local ($_, %_);
+    my $FORM;
+    $FORM = $_[0];
+    # Sanity checks
+    if (    defined $GET->param("selsn")
+            && check_sn_in ${$GET->param_fetch("selsn")}[0], "groups AS members") {
+        # Get the current member list
+        %_ = map { $FORM->param($_) => 1 } grep /^subgroup\d+sn$/, $FORM->param;
+        $_{$GET->param("selsn")} = 1;
+        @_ = sort { groupid $a cmp groupid $b } keys %_;
+        # Get the checked member list
+        %_ = map { $FORM->param($_ . "sn") => 1 }
+            grep /^subgroup\d+$/ && defined $FORM->param($_ . "sn"), $FORM->param;
+        $_{$GET->param("selsn")} = 1;
+        # Remove the old values
+        $FORM->delete(grep /^subgroup\d+/, $FORM->param);
+        # Add the current values
+        for ($_ = 0; $_ < @_; $_++) {
+            $FORM->param("subgroup$_" . "sn", $_[$_]);
+            $FORM->param("subgroup$_", 1) if exists $_{$_[$_]};
+        }
+    }
+    return;
+}
+
+# import_selsupgroup: Import the selected user into the retrieved form
+sub import_selsupgroup($) {
+    local ($_, %_);
+    my $FORM;
+    $FORM = $_[0];
+    # Sanity checks
+    if (    defined $GET->param("selsn")
+            && check_sn_in ${$GET->param_fetch("selsn")}[0], "groups") {
+        # Get the current member list
+        %_ = map { $FORM->param($_) => 1 } grep /^supgroup\d+sn$/, $FORM->param;
+        $_{$GET->param("selsn")} = 1;
+        @_ = sort { groupid $a cmp groupid $b } keys %_;
+        # Get the checked member list
+        %_ = map { $FORM->param($_ . "sn") => 1 }
+            grep /^supgroup\d+$/ && defined $FORM->param($_ . "sn"), $FORM->param;
+        $_{$GET->param("selsn")} = 1;
+        # Remove the old values
+        $FORM->delete(grep /^supgroup\d+/, $FORM->param);
+        # Add the current values
+        for ($_ = 0; $_ < @_; $_++) {
+            $FORM->param("supgroup$_" . "sn", $_[$_]);
+            $FORM->param("supgroup$_", 1) if exists $_{$_[$_]};
+        }
+    }
+    return;
+}

htdocs/htc/magicat/cgi-bin/guestbook.cgi

@@ -0,0 +1,211 @@
+#! /usr/bin/perl -w
+# History: Theory and Culture
+# guestbook.cgi: The guestbook administration.
+
+#  Copyright (c) 2003-2021 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2003-04-06
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::htc;
+local $SIG{"__DIE__"} = \&http_500;
+my $d = new Selima::Destroy;
+# Prototype declaration
+sub main();
+sub check_get();
+sub check_post();
+sub html_page($);
+sub fetch_curitem();
+
+initenv(-restricted => 1,
+        -this_table => "guestbook",
+        -dbi_lock   => {"guestbook"             => LOCK_EX},
+        -lastmod    => 1,
+        -page_param => {"keywords"              => N_("guestbook")});
+
+main;
+exit 0;
+
+sub main() {
+    local ($_, %_);
+    my ($error, $success, $processor);
+    
+    # If the request is a GET query
+    if ($ENV{"REQUEST_METHOD"} ne "POST") {
+        $error = check_get;
+        # If an error occurs
+        if (defined $error) {
+            html_page $error;
+        
+        # Display the page
+        } else {
+            html_page retrieve_status;
+        }
+    
+    # If a form was POSTed from the client
+    } else {
+        $error = check_post;
+        # If an error occurs
+        if (defined $error) {
+            error_redirect $error;
+        
+        # Else, save the data
+        } else {
+            $processor = new Selima::Processor::Guestbook($POST);
+            $success = $processor->process;
+            success_redirect $success;
+        }
+    }
+    return;
+}
+
+# check_get: Check the GET arguments
+sub check_get() {
+    local ($_, %_);
+    my $error;
+    
+    # A form is requested
+    if (is_form) {
+        $_ = form_type;
+        # A form to create a new item
+        if ($_ eq "new") {
+            # Nothing to check on a new form
+        
+        # A form to edit a current item
+        } elsif ($_ eq "cur") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # A form to delete a current item
+        } elsif ($_ eq "del") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # Not a valid form
+        } else {
+            return {"msg"=>N_("Incorrect form: [_1]."),
+                    "margs"=>[$_],
+                    "isform"=>0};
+        }
+    }
+    # List handler handles its own error
+    # OK
+    return;
+}
+
+# check_post: Check the POSTed form
+sub check_post() {
+    local ($_, %_);
+    my ($checker, $error);
+    $_ = form_type;
+    # A form to create a new item
+    if ($_ eq "new") {
+        # Run the checker
+        $checker = new Selima::htc::Checker::Guestbook(curform);
+        $error = $checker->check(qw(name identity location
+            email url message));
+        return $error if defined $error;
+    
+    # A form to edit a current item
+    } elsif ($_ eq "cur") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;
+        # Run the checker
+        $checker = new Selima::htc::Checker::Guestbook(curform);
+        $checker->redir(qw(del));
+        $error = $checker->check(qw(name identity location
+            email url message));
+        return $error if defined $error;
+    
+    # A form to delete a current item
+    } elsif ($_ eq "del") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;;
+        # Run the checker
+        $checker = new Selima::htc::Checker::Guestbook(curform);
+        $checker->redir(qw(cancel));
+    
+    # Not a valid form
+    } else {
+        return {"msg"=>N_("Incorrect form: [_1]."),
+                "margs"=>[$_],
+                "isform"=>0};
+    }
+    # OK
+    return;
+}
+
+# html_page: Display the page
+sub html_page($) {
+    local ($_, %_);
+    my ($status, $LIST, $FORM);
+    $status = $_[0];
+    # A form is requested
+    if (is_form $status) {
+        $FORM = new Selima::htc::Form::Guestbook($status);
+        html_header $FORM->{"title"};
+        html_errmsg $status;
+        $FORM->html;
+        html_footer;
+    
+    # List the available items
+    } else {
+        $LIST = new Selima::htc::List::Guestbook;
+        html_header $LIST->{"title"}, $LIST->page_param;
+        html_errmsg $status;
+        $LIST->html;
+        html_footer;
+    }
+    return;
+}
+
+
+##################################
+# Subroutines to manage the data #
+##################################
+# fetch_curitem: Fetch the current item
+sub fetch_curitem() {
+    local ($_, %_);
+    my ($sn, $FORM);
+    
+    # Return if fetched before
+    return if scalar(keys %CURRENT) > 0;
+    
+    # Obtain the current form
+    $FORM = curform;
+    # No item specified
+    return {"msg"=>N_("Please select the message."),
+            "isform"=>0}
+        if !defined $FORM->param("sn");
+    $sn = $FORM->param("sn");
+    
+    # Find the record
+    %CURRENT = fetchrec $sn, $THIS_TABLE;
+    # If this record exist
+    return {"msg"=>N_("This message does not exist anymore.  Please select another one."),
+            "isform"=>0}
+        if scalar(keys %CURRENT) == 0;
+    
+    # OK
+    return;
+}

htdocs/htc/magicat/cgi-bin/linkcat.cgi

@@ -0,0 +1,292 @@
+#! /usr/bin/perl -w
+# History: Theory and Culture
+# linkcat.cgi: The related-link category administration.
+
+#  Copyright (c) 2004-2021 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2004-11-02
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::htc;
+local $SIG{"__DIE__"} = \&http_500;
+my $d = new Selima::Destroy;
+# Prototype declaration
+sub main();
+sub check_get();
+sub check_post();
+sub html_page($);
+sub fetch_curitem();
+sub import_selparent($);
+
+initenv(-restricted => 1,
+        -this_table => "linkcat",
+        -dbi_lock   => {"linkcat"               => LOCK_EX,
+                        "links"                 => LOCK_SH,
+                        "linkcatz"              => LOCK_SH},
+        -lastmod    => 0,
+        -page_param => {"keywords"              => N_("link categories")});
+
+main;
+exit 0;
+
+sub main() {
+    local ($_, %_);
+    my ($error, $success, $processor);
+    
+    # If the request is a GET query
+    if ($ENV{"REQUEST_METHOD"} ne "POST") {
+        $error = check_get;
+        # If an error occurs
+        if (defined $error) {
+            html_page $error;
+        
+        # Display the page
+        } else {
+            html_page retrieve_status;
+        }
+    
+    # If a form was POSTed from the client
+    } else {
+        $error = check_post;
+        # If an error occurs
+        if (defined $error) {
+            error_redirect $error;
+        
+        # Else, save the data
+        } else {
+            $processor = new Selima::Processor::LinkCat($POST);
+            $success = $processor->process;
+            success_redirect $success;
+        }
+    }
+    return;
+}
+
+# check_get: Check the GET arguments
+sub check_get() {
+    local ($_, %_);
+    my $error;
+    
+    # A form is requested
+    if (is_form) {
+        $_ = form_type;
+        # A form to create a new item
+        if ($_ eq "new") {
+            # Nothing to check on a new form
+        
+        # A form to edit a current item
+        } elsif ($_ eq "cur") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # A form to delete a current item
+        } elsif ($_ eq "del") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+            return {"msg"=>N_("This category has [numerate,_1,a subcategory,subcategories].  It cannot be deleted.  To delete the category, [numerate,_1,its subcategory,all of its subcategories] must first be deleted."),
+                    "margs"=>[$CURRENT{"scatcount"}],
+                    "isform"=>0}
+                if $CURRENT{"scatcount"} > 0;
+            return {"msg"=>N_("This category has [numerate,_1,a link,links].  It cannot be deleted.  To delete the category, [numerate,_1,its link,all of its links] must first be deleted."),
+                    "margs"=>[$CURRENT{"linkcount"}],
+                    "isform"=>0}
+                if $CURRENT{"linkcount"} > 0;
+        
+        # Not a valid form
+        } else {
+            return {"msg"=>N_("Incorrect form: [_1]."),
+                    "margs"=>[$_],
+                    "isform"=>0};
+        }
+    }
+    # List handler handles its own error
+    # OK
+    return;
+}
+
+# check_post: Check the POSTed form
+sub check_post() {
+    local ($_, %_);
+    my ($checker, $error);
+    $_ = form_type;
+    # A form to create a new item
+    if ($_ eq "new") {
+        # Run the checker
+        $checker = new Selima::Checker::LinkCat(curform);
+        $checker->redir(qw(selparent delparent));
+        $error = $checker->check(qw(parent id ord title kw));
+        return $error if defined $error;
+    
+    # A form to edit a current item
+    } elsif ($_ eq "cur") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;
+        # Run the checker
+        $checker = new Selima::Checker::LinkCat(curform);
+        $checker->redir(qw(del selparent delparent));
+        $error = $checker->check(qw(parent id ord title kw));
+        return $error if defined $error;
+    
+    # A form to delete a current item
+    } elsif ($_ eq "del") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;
+        # Run the checker
+        $checker = new Selima::Checker::LinkCat(curform);
+        $checker->redir(qw(cancel));
+        return {"msg"=>N_("This category has [numerate,_1,a subcategory,subcategories].  It cannot be deleted.  To delete the category, [numerate,_1,its subcategory,all of its subcategories] must first be deleted."),
+                "margs"=>[$CURRENT{"scatcount"}],
+                "isform"=>0}
+            if $CURRENT{"scatcount"} > 0;
+        return {"msg"=>N_("This category has [numerate,_1,a link,links].  It cannot be deleted.  To delete the category, [numerate,_1,its link,all of its links] must first be deleted."),
+                "margs"=>[$CURRENT{"linkcount"}],
+                "isform"=>0}
+            if $CURRENT{"linkcount"} > 0;
+    
+    # Not a valid form
+    } else {
+        return {"msg"=>N_("Incorrect form: [_1]."),
+                "margs"=>[$_],
+                "isform"=>0};
+    }
+    # OK
+    return;
+}
+
+# html_page: Display the page
+sub html_page($) {
+    local ($_, %_);
+    my ($status, $LIST, $FORM);
+    $status = $_[0];
+    # A form is requested
+    if (is_form $status) {
+        $FORM = new Selima::Form::LinkCat($status);
+        html_header $FORM->{"title"};
+        html_errmsg $status;
+        $FORM->html;
+        html_footer;
+    
+    # List the available items
+    } else {
+        $LIST = new Selima::List::LinkCat;
+        html_header $LIST->{"title"}, $LIST->page_param;
+        html_errmsg $status;
+        $LIST->html;
+        html_footer;
+    }
+    return;
+}
+
+
+##################################
+# Subroutines to manage the data #
+##################################
+# fetch_curitem: Fetch the current item
+sub fetch_curitem() {
+    local ($_, %_);
+    my ($sn, $FORM, $sth, $sql, $row);
+    my ($lang, $lndb, $lndbdef, $langfile, $title);
+    
+    # Return if fetched before
+    return if scalar(keys %CURRENT) > 0;
+    
+    # Obtain the current form
+    $FORM = curform;
+    # No item specified
+    return {"msg"=>N_("Please select the category."),
+            "isform"=>0}
+        if !defined $FORM->param("sn");
+    $sn = $FORM->param("sn");
+    
+    # Find the record
+    %CURRENT = fetchrec $sn, $THIS_TABLE;
+    # If this record exist
+    return {"msg"=>N_("This category does not exist anymore.  Please select another one."),
+            "isform"=>0}
+        if scalar(keys %CURRENT) == 0;
+    
+    $lang = getlang;
+    $lndb = getlang LN_DATABASE;
+    $lndbdef = ln $DEFAULT_LANG, LN_DATABASE;
+    $langfile = getlang LN_FILENAME;
+    
+    # Obtain the belonging subcategories list
+    @_ = qw();
+    push @_, "sn AS sn";
+    if (@ALL_LINGUAS > 1) {
+        $title = $lang eq $DEFAULT_LANG? "title_$lndb":
+            "COALESCE(title_$lndb, title_$lndbdef)";
+        push @_, "linkcat_fulltitle('$lang', parent, $title) AS title";
+    } else {
+        push @_, "linkcat_fulltitle(parent, title) AS title";
+    }
+    push @_, $DBH->strcat("'/links'", "linkcat_path(sn, id, parent)")
+        . " AS url";
+    $sql = "SELECT " . join(", ", @_) . " FROM linkcat"
+        . " WHERE linkcat_ischild($sn, sn)"
+        . " ORDER BY linkcat_fullord(parent, ord);\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    $CURRENT{"scatcount"} = $sth->rows;
+    for ($_ = 0; $_ < $CURRENT{"scatcount"}; $_++) {
+        $row = $sth->fetchrow_hashref;
+        $CURRENT{"scat$_" . "sn"} = $$row{"sn"};
+        $CURRENT{"scat$_" . "title"} = $$row{"title"};
+        $CURRENT{"scat$_" . "url"} = $$row{"url"};
+    }
+    
+    # Obtain the belonging links list
+    @_ = qw();
+    push @_, "links.sn AS sn";
+    push @_, "links.title AS title";
+    push @_, "url AS url";
+    $sql = "SELECT " . join(", ", @_) . " FROM links"
+        . " INNER JOIN linkcatz ON linkcatz.link=links.sn"
+        . " WHERE linkcatz.cat=$sn"
+        . " ORDER BY title;\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    $CURRENT{"linkcount"} = $sth->rows;
+    for ($_ = 0; $_ < $CURRENT{"linkcount"}; $_++) {
+        $row = $sth->fetchrow_hashref;
+        $CURRENT{"link$_" . "sn"} = $$row{"sn"};
+        $CURRENT{"link$_" . "title"} = $$row{"title"};
+        $CURRENT{"link$_" . "url"} = $$row{"url"};
+    }
+    
+    # OK
+    return;
+}
+
+# import_selparent: Import the selected parent into the retrieved form
+sub import_selparent($) {
+    local ($_, %_);
+    my $FORM;
+    $FORM = $_[0];
+    if (    defined $GET->param("selsn")
+            && check_sn_in ${$GET->param_fetch("selsn")}[0], "linkcat") {
+        $FORM->param("parent", $GET->param("selsn"));
+        $FORM->param("topmost", "false");
+    }
+    return;
+}

htdocs/htc/magicat/cgi-bin/linkcatz.cgi

@@ -0,0 +1,236 @@
+#! /usr/bin/perl -w
+# History: Theory and Culture
+# linkcatz.cgi: The related-link category membership administration.
+
+#  Copyright (c) 2004-2021 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2004-11-02
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::htc;
+local $SIG{"__DIE__"} = \&http_500;
+my $d = new Selima::Destroy;
+# Prototype declaration
+sub main();
+sub check_get();
+sub check_post();
+sub html_page($);
+sub fetch_curitem();
+sub import_selcat($);
+sub import_sellink($);
+
+initenv(-restricted => 1,
+        -this_table => "linkcatz",
+        -dbi_lock   => {"linkcatz"              => LOCK_EX,
+                        "linkcat"               => LOCK_SH,
+                        "links"                 => LOCK_SH},
+        -lastmod    => 1,
+        -page_param => {"keywords"              => N_("link categorization")});
+
+main;
+exit 0;
+
+sub main() {
+    local ($_, %_);
+    my ($error, $success, $processor);
+    
+    # If the request is a GET query
+    if ($ENV{"REQUEST_METHOD"} ne "POST") {
+        $error = check_get;
+        # If an error occurs
+        if (defined $error) {
+            html_page $error;
+        
+        # Display the page
+        } else {
+            html_page retrieve_status;
+        }
+    
+    # If a form was POSTed from the client
+    } else {
+        $error = check_post;
+        # If an error occurs
+        if (defined $error) {
+            error_redirect $error;
+        
+        # Else, save the data
+        } else {
+            $processor = new Selima::Processor::LinkCatz($POST);
+            $success = $processor->process;
+            success_redirect $success;
+        }
+    }
+    return;
+}
+
+# check_get: Check the GET arguments
+sub check_get() {
+    local ($_, %_);
+    my $error;
+    
+    # A form is requested
+    if (is_form) {
+        $_ = form_type;
+        # A form to create a new item
+        if ($_ eq "new") {
+            # Nothing to check on a new form
+        
+        # A form to edit a current item
+        } elsif ($_ eq "cur") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # A form to delete a current item
+        } elsif ($_ eq "del") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # Not a valid form
+        } else {
+            return {"msg"=>N_("Incorrect form: [_1]."),
+                    "margs"=>[$_],
+                    "isform"=>0};
+        }
+    }
+    # List handler handles its own error
+    # OK
+    return;
+}
+
+# check_post: Check the POSTed form
+sub check_post() {
+    local ($_, %_);
+    my ($checker, $error);
+    $_ = form_type;
+    # A form to create a new item
+    if ($_ eq "new") {
+        # Run the checker
+        $checker = new Selima::Checker::LinkCatz(curform);
+        $checker->redir(qw(selcat delcat sellink dellink));
+        $error = $checker->check(qw(cat link));
+        return $error if defined $error;
+    
+    # A form to edit a current item
+    } elsif ($_ eq "cur") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;
+        # Run the checker
+        $checker = new Selima::Checker::LinkCatz(curform);
+        $checker->redir(qw(del selcat delcat sellink dellink));
+        $error = $checker->check(qw(cat link));
+        return $error if defined $error;
+    
+    # A form to delete a current item
+    } elsif ($_ eq "del") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;;
+        # Run the checker
+        $checker = new Selima::Checker::LinkCatz(curform);
+        $checker->redir(qw(cancel));
+    
+    # Not a valid form
+    } else {
+        return {"msg"=>N_("Incorrect form: [_1]."),
+                "margs"=>[$_],
+                "isform"=>0};
+    }
+    # OK
+    return;
+}
+
+# html_page: Display the page
+sub html_page($) {
+    local ($_, %_);
+    my ($status, $LIST, $FORM);
+    $status = $_[0];
+    # A form is requested
+    if (is_form $status) {
+        $FORM = new Selima::Form::LinkCatz($status);
+        html_header $FORM->{"title"};
+        html_errmsg $status;
+        $FORM->html;
+        html_footer;
+    
+    # List the available items
+    } else {
+        $LIST = new Selima::List::LinkCatz;
+        html_header $LIST->{"title"}, $LIST->page_param;
+        html_errmsg $status;
+        $LIST->html;
+        html_footer;
+    }
+    return;
+}
+
+
+##################################
+# Subroutines to manage the data #
+##################################
+# fetch_curitem: Fetch the current item
+sub fetch_curitem() {
+    local ($_, %_);
+    my ($sn, $FORM);
+    
+    # Return if fetched before
+    return if scalar(keys %CURRENT) > 0;
+    
+    # Obtain the current form
+    $FORM = curform;
+    # No item specified
+    return {"msg"=>N_("Please select the categorization record."),
+            "isform"=>0}
+        if !defined $FORM->param("sn");
+    $sn = $FORM->param("sn");
+    
+    # Find the record
+    %CURRENT = fetchrec $sn, $THIS_TABLE;
+    # If this record exist
+    return {"msg"=>N_("This categorization record does not exist anymore.  Please select another one."),
+            "isform"=>0}
+        if scalar(keys %CURRENT) == 0;
+    
+    # OK
+    return;
+}
+
+# import_selcat: Import the selected category into the retrieved form
+sub import_selcat($) {
+    local ($_, %_);
+    my $FORM;
+    $FORM = $_[0];
+    $FORM->param("cat", $GET->param("selsn"))
+        if  defined $GET->param("selsn")
+            && check_sn_in ${$GET->param_fetch("selsn")}[0], "linkcat";
+    return;
+}
+
+# import_sellink: Import the selected link into the retrieved form
+sub import_sellink($) {
+    local ($_, %_);
+    my $FORM;
+    $FORM = $_[0];
+    $FORM->param("link", $GET->param("selsn"))
+        if  defined $GET->param("selsn")
+            && check_sn_in ${$GET->param_fetch("selsn")}[0], "links";
+    return $FORM;
+}

htdocs/htc/magicat/cgi-bin/links.cgi

@@ -0,0 +1,240 @@
+#! /usr/bin/perl -w
+# History: Theory and Culture
+# links.cgi: The related-link administration.
+
+#  Copyright (c) 2004-2021 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2004-11-02
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::htc;
+local $SIG{"__DIE__"} = \&http_500;
+my $d = new Selima::Destroy;
+# Prototype declaration
+sub main();
+sub check_get();
+sub check_post();
+sub html_page($);
+sub fetch_curitem();
+
+initenv(-restricted => 1,
+        -this_table => "links",
+        -dbi_lock   => {"links"                 => LOCK_EX,
+                        "linkcatz"              => LOCK_EX,
+                        "linkcat"               => LOCK_SH},
+        -lastmod    => 1,
+        -page_param => {"keywords"              => N_("related links")});
+
+main;
+exit 0;
+
+sub main() {
+    local ($_, %_);
+    my ($error, $success, $processor);
+    
+    # If the request is a GET query
+    if ($ENV{"REQUEST_METHOD"} ne "POST") {
+        $error = check_get;
+        # If an error occurs
+        if (defined $error) {
+            html_page $error;
+        
+        # Display the page
+        } else {
+            html_page retrieve_status;
+        }
+    
+    # If a form was POSTed from the client
+    } else {
+        $error = check_post;
+        # If an error occurs
+        if (defined $error) {
+            error_redirect $error;
+        
+        # Else, save the data
+        } else {
+            $processor = new Selima::Processor::Link($POST);
+            $success = $processor->process;
+            success_redirect $success;
+        }
+    }
+    return;
+}
+
+# check_get: Check the GET arguments
+sub check_get() {
+    local ($_, %_);
+    my $error;
+    
+    # A form is requested
+    if (is_form) {
+        $_ = form_type;
+        # A form to create a new item
+        if ($_ eq "new") {
+        
+        # A form to edit a current item
+        } elsif ($_ eq "cur") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # A form to delete a current item
+        } elsif ($_ eq "del") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # Not a valid form
+        } else {
+            return {"msg"=>N_("Incorrect form: [_1]."),
+                    "margs"=>[$_],
+                    "isform"=>0};
+        }
+    }
+    # List handler handles its own error
+    # OK
+    return;
+}
+
+# check_post: Check the POSTed form
+sub check_post() {
+    local ($_, %_);
+    my ($checker, $error);
+    $_ = form_type;
+    # A form to create a new item
+    if ($_ eq "new") {
+        # Run the checker
+        $checker = new Selima::Checker::Link(curform);
+        $error = $checker->check(qw(title title_2ln url icon
+            email addr tel fax dsc cats));
+        return $error if defined $error;
+    
+    # A form to edit a current item
+    } elsif ($_ eq "cur") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;
+        # Run the checker
+        $checker = new Selima::Checker::Link(curform);
+        $checker->redir(qw(del));
+        $error = $checker->check(qw(title title_2ln url icon
+            email addr tel fax dsc cats));
+        return $error if defined $error;
+    
+    # A form to delete a current item
+    } elsif ($_ eq "del") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;;
+        # Run the checker
+        $checker = new Selima::Checker::Link(curform);
+        $checker->redir(qw(cancel));
+    
+    # Not a valid form
+    } else {
+        return {"msg"=>N_("Incorrect form: [_1]."),
+                "margs"=>[$_],
+                "isform"=>0};
+    }
+    # OK
+    return;
+}
+
+# html_page: Display the page
+sub html_page($) {
+    local ($_, %_);
+    my ($status, $LIST, $FORM);
+    $status = $_[0];
+    # A form is requested
+    if (is_form $status) {
+        $FORM = new Selima::Form::Link($status);
+        html_header $FORM->{"title"};
+        html_errmsg $status;
+        $FORM->html;
+        html_footer;
+    
+    # List the available items
+    } else {
+        $LIST = new Selima::List::Links;
+        html_header $LIST->{"title"}, $LIST->page_param;
+        html_errmsg $status;
+        $LIST->html;
+        html_footer;
+    }
+    return;
+}
+
+
+##################################
+# Subroutines to manage the data #
+##################################
+# fetch_curitem: Fetch the current item
+sub fetch_curitem() {
+    local ($_, %_);
+    my ($sn, $FORM, $sth, $sql, $row);
+    my ($lang, $lndb, $lndbdef, $title);
+    
+    # Return if fetched before
+    return if scalar(keys %CURRENT) > 0;
+    
+    # Obtain the current form
+    $FORM = curform;
+    # No item specified
+    return {"msg"=>N_("Please select the related link."),
+            "isform"=>0}
+        if !defined $FORM->param("sn");
+    $sn = $FORM->param("sn");
+    
+    # Find the record
+    %CURRENT = fetchrec $sn, $THIS_TABLE;
+    # If this record exist
+    return {"msg"=>N_("This related link does not exist anymore.  Please select another one."),
+            "isform"=>0}
+        if scalar(keys %CURRENT) == 0;
+    
+    $lang = getlang;
+    $lndb = getlang LN_DATABASE;
+    $lndbdef = ln $DEFAULT_LANG, LN_DATABASE;
+    
+    # Obtain the parent categories list
+    @_ = qw();
+    push @_, "linkcat.sn AS sn";
+    if (@ALL_LINGUAS > 1) {
+        $title = $lang eq $DEFAULT_LANG? "linkcat.title_$lndb":
+            "COALESCE(linkcat.title_$lndb, linkcat.title_$lndbdef)";
+        push @_, "linkcat_fulltitle('$lang', linkcat.parent, $title) AS title";
+    } else {
+        push @_, "linkcat_fulltitle(linkcat.parent, linkcat.title) AS title";
+    }
+    $sql = "SELECT " . join(", ", @_) . " FROM linkcat"
+        . " INNER JOIN linkcatz ON linkcatz.cat=linkcat.sn"
+        . " WHERE linkcatz.link=$sn"
+        . " ORDER BY linkcat_fullord(linkcat.parent, linkcat.ord);\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    $CURRENT{"catcount"} = $sth->rows;
+    for ($_ = 0; $_ < $CURRENT{"catcount"}; $_++) {
+        $row = $sth->fetchrow_hashref;
+        $CURRENT{"cat$_"} = $$row{"sn"};
+        $CURRENT{"cat$_" . "title"} = $$row{"title"};
+    }
+    
+    # OK
+    return;
+}

htdocs/htc/magicat/cgi-bin/logout.cgi

@@ -0,0 +1,158 @@
+#! /usr/bin/perl -w
+# History: Theory and Culture
+# logout.cgi: The log-out script.
+
+#  Copyright (c) 2004-2021 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2004-10-16
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::htc;
+local $SIG{"__DIE__"} = \&http_500;
+my $d = new Selima::Destroy;
+# Prototype declaration
+sub main();
+sub check_get();
+sub check_post();
+sub html_page($);
+sub html_logoutform();
+sub html_relogin();
+
+initenv(-dbi        => DBI_NONE,
+        -lastmod    => 1,
+        -page_param => {"keywords"              => N_("log out")});
+
+main;
+exit 0;
+
+sub main() {
+    local ($_, %_);
+    my ($error, $success, $processor);
+    
+    # If the request is a GET query
+    if ($ENV{"REQUEST_METHOD"} ne "POST") {
+        $error = check_get;
+        # If an error occurs
+        if (defined $error) {
+            html_page $error;
+        
+        # Display the page
+        } else {
+            html_page retrieve_status;
+        }
+    
+    # If a form was POSTed from the client
+    } else {
+        $error = check_post;
+        # If an error occurs
+        if (defined $error) {
+            error_redirect $error;
+        
+        # Else, save the data
+        } else {
+            $processor = new Selima::Processor::LogOut($POST);
+            $success = $processor->process;
+            success_redirect $success;
+        }
+    }
+    return;
+}
+
+# check_get: Check the GET arguments
+sub check_get() {
+    local ($_, %_);
+    my $status;
+    # There is a result to display
+    $status = retrieve_status;
+    # Successfully logged out
+    if (    defined $status
+            && exists $$status{"status"}
+            && $$status{"status"} eq "success") {
+        # Nothing to check
+        return;
+    }
+    # Check if this user has logged in
+    unauth unless defined get_login_sn;
+    # OK
+    return;
+}
+
+# check_post: Check the POSTed form
+sub check_post() {
+    local ($_, %_);
+    # Check if this user has logged in
+    unauth unless defined get_login_sn;
+    # OK
+    return;
+}
+
+# html_page: Display the page
+sub html_page($) {
+    local ($_, %_);
+    my $status;
+    $status = $_[0];
+    # Not logged out yet
+    if (defined get_login_sn) {
+        html_header __("Log Out");
+        html_errmsg $status;
+        html_logoutform;
+        html_footer;
+    
+    # Logged out
+    } else {
+        html_header __("Log Out");
+        html_errmsg $status;
+        html_relogin;
+        html_footer;
+    }
+    return;
+}
+
+
+##################################
+# Subroutines to manage the data #
+##################################
+# html_logoutform: Display a form to log out
+sub html_logoutform() {
+    local ($_, %_);
+    my ($msg, $submit);
+    $msg = h(__("Are you sure you want to log out?"));
+    $submit = h(__("Log out"));
+    print << "EOT";
+<form action="$REQUEST_FILE" method="post">
+<div>
+<p>$msg</p>
+<input type="submit" value="$submit" />
+</div>
+</form>
+
+EOT
+    return;
+}
+
+# html_relogin: Display links to log in again
+sub html_relogin() {
+    local ($_, %_);
+    $_ = h(__("Log in again."));
+    print << "EOT";
+<p><a href="/magicat/cgi-bin/login.cgi">$_</a></p>
+
+EOT
+    return;
+}

htdocs/htc/magicat/cgi-bin/newslets.cgi

@@ -0,0 +1,345 @@
+#! /usr/bin/perl -w
+# History: Theory and Culture
+# newslets.cgi: The newsletter administration.
+
+#  Copyright (c) 2006-2021 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-28
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::htc;
+local $SIG{"__DIE__"} = \&http_500;
+my $d = new Selima::Destroy;
+# Prototype declaration
+sub main();
+sub check_get();
+sub check_post();
+sub html_page($);
+sub fetch_curitem();
+sub fetch_index($$$);
+
+use Date::Parse qw(str2time);
+
+initenv(-restricted => 1,
+        -this_table => "newslets",
+        -dbi_lock   => {"newslets"              => LOCK_EX,
+                        "nlindex"               => LOCK_EX,
+                        "nlarts"                => LOCK_SH},
+        -lastmod    => 1,
+        -page_param => {"keywords"              => N_("newsletters")});
+
+main;
+exit 0;
+
+sub main() {
+    local ($_, %_);
+    my ($error, $success, $processor);
+    
+    # If the request is a GET query
+    if ($ENV{"REQUEST_METHOD"} ne "POST") {
+        $error = check_get;
+        # If an error occurs
+        if (defined $error) {
+            html_page $error;
+        
+        # Display the page
+        } else {
+            html_page retrieve_status;
+        }
+    
+    # If a form was POSTed from the client
+    } else {
+        $error = check_post;
+        # If an error occurs
+        if (defined $error) {
+            error_redirect $error;
+        
+        # Else, save the data
+        } else {
+            $processor = new Selima::htc::Processor::Newslet($POST);
+            $success = $processor->process;
+            success_redirect $success;
+        }
+    }
+    return;
+}
+
+# check_get: Check the GET arguments
+sub check_get() {
+    local ($_, %_);
+    my $error;
+    
+    # A form is requested
+    if (is_form) {
+        $_ = form_type;
+        # A form to create a new item
+        if ($_ eq "new") {
+        
+        # A form to edit a current item
+        } elsif ($_ eq "cur") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # A form to delete a current item
+        } elsif ($_ eq "del") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # A form to preview a submitted item
+        } elsif ($_ eq "preview") {
+            my ($sql, $sth, $count, $row, @allno);
+            # Check at fetch_preview()
+            $error = fetch_preview;
+            return $error if defined $error;
+            $PREVIEW{"path"} = sprintf "/newsletters/%03d/", $PREVIEW{"no"};
+            $PREVIEW{"date"} = str2time $PREVIEW{"date"};
+            $PREVIEW{"title"} = newslet_textno($PREVIEW{"no"}) . " " . $PREVIEW{"title"};
+            
+            # Obtain all the pages
+            @_ = qw();
+            push @_, "sn!=" . $PREVIEW{"sn"} if exists $PREVIEW{"sn"};
+            push @_, "NOT hid";
+            $sql = "SELECT no FROM newslets"
+                . " WHERE " . join(" AND ", @_)
+                . " ORDER BY no;\n";
+            $sth = $DBH->prepare($sql);
+            $sth->execute;
+            $count = $sth->rows;
+            for (my $i = 0, @allno = qw(); $i < $count; $i++) {
+                push @allno, ${$sth->fetch}[0];
+            }
+            undef $sth;
+            # Insert this page
+            for ($_ = 0; $_ < @allno; $_++) {
+                last if $PREVIEW{"no"} < $allno[$_];
+            }
+            @allno = (
+                @allno[0..$_-1],
+                $PREVIEW{"no"},
+                @allno[$_..$#allno]);
+            $PREVIEW{"allno"} = [@allno];
+        
+        # Not a valid form
+        } else {
+            return {"msg"=>N_("Incorrect form: [_1]."),
+                    "margs"=>[$_],
+                    "isform"=>0};
+        }
+    }
+    # List handler handles its own error
+    # OK
+    return;
+}
+
+# check_post: Check the POSTed form
+sub check_post() {
+    local ($_, %_);
+    my ($checker, $error);
+    $_ = form_type;
+    # A form to create a new item
+    if ($_ eq "new") {
+        # Run the checker
+        $checker = new Selima::htc::Checker::Newslet(curform);
+        $checker->redir(qw(selndxart delndxart));
+        $error = $checker->check(qw(no date title credits kw));
+        return $error if defined $error;
+    
+    # A form to edit a current item
+    } elsif ($_ eq "cur") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;
+        # Run the checker
+        $checker = new Selima::htc::Checker::Newslet(curform);
+        $checker->redir(qw(del selndxart delndxart));
+        $error = $checker->check(qw(no date title credits kw));
+        return $error if defined $error;
+    
+    # A form to delete a current item
+    } elsif ($_ eq "del") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;;
+        # Run the checker
+        $checker = new Selima::htc::Checker::Newslet(curform);
+        $checker->redir(qw(cancel));
+    
+    # Not a valid form
+    } else {
+        return {"msg"=>N_("Incorrect form: [_1]."),
+                "margs"=>[$_],
+                "isform"=>0};
+    }
+    # OK
+    return;
+}
+
+# html_page: Display the page
+sub html_page($) {
+    local ($_, %_);
+    my ($status, $LIST, $FORM);
+    $status = $_[0];
+    # A form is requested
+    if (is_form $status) {
+        # A form to preview a submitted item
+        if (form_type eq "preview") {
+            html_preview;
+        
+        } else {
+            $FORM = new Selima::htc::Form::Newslet($status);
+            html_header $FORM->{"title"};
+            html_errmsg $status;
+            $FORM->html;
+            html_footer;
+        }
+    
+    # List the available items
+    } else {
+        $LIST = new Selima::htc::List::Newslets;
+        html_header $LIST->{"title"}, $LIST->page_param;
+        html_errmsg $status;
+        $LIST->html;
+        html_footer;
+    }
+    return;
+}
+
+
+##################################
+# Subroutines to manage the data #
+##################################
+# fetch_curitem: Fetch the current item
+sub fetch_curitem() {
+    local ($_, %_);
+    my ($sn, $FORM, $sth, $sql, $row);
+    
+    # Return if fetched before
+    return if scalar(keys %CURRENT) > 0;
+    
+    # Obtain the current form
+    $FORM = curform;
+    # No item specified
+    return {"msg"=>N_("Please select the newsletter."),
+            "isform"=>0}
+        if !defined $FORM->param("sn");
+    $sn = $FORM->param("sn");
+    
+    # Find the record
+    %CURRENT = fetchrec $sn, $THIS_TABLE;
+    # If this record exist
+    return {"msg"=>N_("This newsletter does not exist anymore.  Please select another one."),
+            "isform"=>0}
+        if scalar(keys %CURRENT) == 0;
+    
+    # Obtain the date
+    $CURRENT{"date"} = fmtdate $CURRENT{"date"};
+    
+    # Obtain the belonging index items list
+    @_ = qw();
+    push @_, "sn AS sn";
+    push @_, "art AS art";
+    push @_, "title AS title";
+    $sql = "SELECT " . join(", ", @_) . " FROM nlindex"
+        . " WHERE newslet=$sn"
+        . " AND parent IS NULL"
+        . " ORDER BY ord;\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    $CURRENT{"ndxcount"} = $sth->rows;
+    for ($_ = 0; $_ < $CURRENT{"ndxcount"}; $_++) {
+        $row = $sth->fetchrow_hashref;
+        $CURRENT{"ndx$_"} = 1;
+        $CURRENT{"ndx$_" . "sn"} = $$row{"sn"};
+        $CURRENT{"ndx$_" . "art"} = $$row{"art"};
+        $CURRENT{"ndx$_" . "title"} = $$row{"title"};
+    }
+    for ($_ = 0; $_ < $CURRENT{"ndxcount"}; $_++) {
+        fetch_index $sn, $CURRENT{"ndx$_" . "sn"}, "ndx$_" . "sub";
+    }
+    
+    # Obtain the belonging articles list
+    @_ = qw();
+    push @_, "sn AS sn";
+    push @_, "title AS title";
+    $sql = "SELECT " . join(", ", @_) . " FROM nlarts"
+        . " WHERE newslet=$sn"
+        . " ORDER BY ord;\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    $CURRENT{"artcount"} = $sth->rows;
+    for ($_ = 0; $_ < $CURRENT{"artcount"}; $_++) {
+        $row = $sth->fetchrow_hashref;
+        $CURRENT{"art$_" . "sn"} = $$row{"sn"};
+        $CURRENT{"art$_" . "title"} = $$row{"title"};
+    }
+    
+    # OK
+    return;
+}
+
+# fetch_index: Fetch the index of the current item
+sub fetch_index($$$) {
+    local ($_, %_);
+    my ($sn, $parent, $prefix, $sql, $sth, $count, $row);
+    ($sn, $parent, $prefix) = @_;
+    
+    # Find the items
+    @_ = qw();
+    push @_, "sn AS sn";
+    push @_, "art AS art";
+    push @_, "title AS title";
+    $sql = "SELECT " . join(", ", @_) . " FROM nlindex"
+        . " WHERE newslet=$sn"
+        . " AND parent=$parent"
+        . " ORDER BY ord;\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    $count = $sth->rows;
+    return if $count == 0;
+    $CURRENT{$prefix} = 1;
+    $CURRENT{$prefix . "count"} = $count;
+    for ($_ = 0; $_ < $CURRENT{$prefix . "count"}; $_++) {
+        $row = $sth->fetchrow_hashref;
+        $CURRENT{"$prefix$_"} = 1;
+        $CURRENT{"$prefix$_" . "sn"} = $$row{"sn"};
+        $CURRENT{"$prefix$_" . "art"} = $$row{"art"};
+        $CURRENT{"$prefix$_" . "title"} = $$row{"title"};
+    }
+    undef $sth;
+    
+    # Find the subitems
+    for ($_ = 0; $_ < $CURRENT{$prefix . "count"}; $_++) {
+        fetch_index $sn, $CURRENT{"$prefix$_" . "sn"}, "$prefix$_" . "sub";
+    }
+    return;
+}
+
+# import_selndxart: Import the selected index item article into the retrieved form
+sub import_selndxart($) {
+    local ($_, %_);
+    my $FORM;
+    $FORM = $_[0];
+    $FORM->param($FORM->param("caller_index"), $GET->param("selsn"))
+        if  defined $FORM->param("caller_index")
+            && defined $GET->param("selsn")
+            && check_sn_in ${$GET->param_fetch("selsn")}[0], "nlarts";
+    return;
+}

htdocs/htc/magicat/cgi-bin/nlarts.cgi

@@ -0,0 +1,226 @@
+#! /usr/bin/perl -w
+# History: Theory and Culture
+# nlarts.cgi: The newsletter article administration.
+
+#  Copyright (c) 2006-2021 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-30
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::htc;
+local $SIG{"__DIE__"} = \&http_500;
+my $d = new Selima::Destroy;
+# Prototype declaration
+sub main();
+sub check_get();
+sub check_post();
+sub html_page($);
+sub fetch_curitem();
+sub import_selparent($);
+
+initenv(-restricted => 1,
+        -this_table => "nlarts",
+        -dbi_lock   => {"nlarts"                => LOCK_EX,
+                        "newslets"              => LOCK_SH,
+                        "nlindex"               => LOCK_SH},
+        -lastmod    => 0,
+        -page_param => {"keywords"              => N_("newsletter articles")});
+
+main;
+exit 0;
+
+sub main() {
+    local ($_, %_);
+    my ($error, $success, $processor);
+    
+    # If the request is a GET query
+    if ($ENV{"REQUEST_METHOD"} ne "POST") {
+        $error = check_get;
+        # If an error occurs
+        if (defined $error) {
+            html_page $error;
+        
+        # Display the page
+        } else {
+            html_page retrieve_status;
+        }
+    
+    # If a form was POSTed from the client
+    } else {
+        $error = check_post;
+        # If an error occurs
+        if (defined $error) {
+            error_redirect $error;
+        
+        # Else, save the data
+        } else {
+            $processor = new Selima::htc::Processor::NLArt($POST);
+            $success = $processor->process;
+            success_redirect $success;
+        }
+    }
+    return;
+}
+
+# check_get: Check the GET arguments
+sub check_get() {
+    local ($_, %_);
+    my $error;
+    
+    # A form is requested
+    if (is_form) {
+        $_ = form_type;
+        # A form to create a new item
+        if ($_ eq "new") {
+            # Nothing to check on a new form
+        
+        # A form to edit a current item
+        } elsif ($_ eq "cur") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # A form to delete a current item
+        } elsif ($_ eq "del") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # Not a valid form
+        } else {
+            return {"msg"=>N_("Incorrect form: [_1]."),
+                    "margs"=>[$_],
+                    "isform"=>0};
+        }
+    }
+    # List handler handles its own error
+    # OK
+    return;
+}
+
+# check_post: Check the POSTed form
+sub check_post() {
+    local ($_, %_);
+    my ($checker, $error);
+    $_ = form_type;
+    # A form to create a new item
+    if ($_ eq "new") {
+        # Run the checker
+        $checker = new Selima::htc::Checker::NLArt(curform);
+        $checker->redir(qw(selnewslet delnewslet));
+        $error = $checker->check(qw(newslet ord title title_h author
+            email authors body annots kw));
+        return $error if defined $error;
+    
+    # A form to edit a current item
+    } elsif ($_ eq "cur") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;
+        # Run the checker
+        $checker = new Selima::htc::Checker::NLArt(curform);
+        $checker->redir(qw(del selnewslet delnewslet));
+        $error = $checker->check(qw(newslet ord title title_h author
+            email authors body annots kw));
+        return $error if defined $error;
+    
+    # A form to delete a current item
+    } elsif ($_ eq "del") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;
+        # Run the checker
+        $checker = new Selima::htc::Checker::NLArt(curform);
+        $checker->redir(qw(cancel));
+    
+    # Not a valid form
+    } else {
+        return {"msg"=>N_("Incorrect form: [_1]."),
+                "margs"=>[$_],
+                "isform"=>0};
+    }
+    # OK
+    return;
+}
+
+# html_page: Display the page
+sub html_page($) {
+    local ($_, %_);
+    my ($status, $LIST, $FORM);
+    $status = $_[0];
+    # A form is requested
+    if (is_form $status) {
+        $FORM = new Selima::htc::Form::NLArt($status);
+        html_header $FORM->{"title"};
+        html_errmsg $status;
+        $FORM->html;
+        html_footer;
+    
+    # List the available items
+    } else {
+        $LIST = new Selima::htc::List::NLArts;
+        html_header $LIST->{"title"}, $LIST->page_param;
+        html_errmsg $status;
+        $LIST->html;
+        html_footer;
+    }
+    return;
+}
+
+
+##################################
+# Subroutines to manage the data #
+##################################
+# fetch_curitem: Fetch the current item
+sub fetch_curitem() {
+    local ($_, %_);
+    my ($sn, $FORM, $sth, $sql, $row);
+    
+    # Return if fetched before
+    return if scalar(keys %CURRENT) > 0;
+    
+    # Obtain the current form
+    $FORM = curform;
+    # No item specified
+    return {"msg"=>N_("Please select the article."),
+            "isform"=>0}
+        if !defined $FORM->param("sn");
+    $sn = $FORM->param("sn");
+    
+    # Find the record
+    %CURRENT = fetchrec $sn, $THIS_TABLE;
+    # If this record exist
+    return {"msg"=>N_("This article does not exist anymore.  Please select another one."),
+            "isform"=>0}
+        if scalar(keys %CURRENT) == 0;
+    
+    # OK
+    return;
+}
+
+# import_selnewslet: Import the selected newsletter into the retrieved form
+sub import_selnewslet($) {
+    local ($_, %_);
+    my $FORM;
+    $FORM = $_[0];
+    $FORM->param("newslet", $GET->param("selsn"))
+        if  defined $GET->param("selsn")
+            && check_sn_in ${$GET->param_fetch("selsn")}[0], "newslets";
+    return;
+}

htdocs/htc/magicat/cgi-bin/nlindex.cgi

@@ -0,0 +1,273 @@
+#! /usr/bin/perl -w
+# History: Theory and Culture
+# nlindex.cgi: The newsletter index administration.
+
+#  Copyright (c) 2004-2021 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2004-11-02
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::htc;
+local $SIG{"__DIE__"} = \&http_500;
+my $d = new Selima::Destroy;
+# Prototype declaration
+sub main();
+sub check_get();
+sub check_post();
+sub html_page($);
+sub fetch_curitem();
+sub import_selparent($);
+
+initenv(-restricted => 1,
+        -this_table => "nlindex",
+        -dbi_lock   => {"nlindex"               => LOCK_EX,
+                        "newslets"              => LOCK_SH,
+                        "nlarts"                => LOCK_SH},
+        -lastmod    => 0,
+        -page_param => {"keywords"              => N_("newsletter indices")});
+
+main;
+exit 0;
+
+sub main() {
+    local ($_, %_);
+    my ($error, $success, $processor);
+    
+    # If the request is a GET query
+    if ($ENV{"REQUEST_METHOD"} ne "POST") {
+        $error = check_get;
+        # If an error occurs
+        if (defined $error) {
+            html_page $error;
+        
+        # Display the page
+        } else {
+            html_page retrieve_status;
+        }
+    
+    # If a form was POSTed from the client
+    } else {
+        $error = check_post;
+        # If an error occurs
+        if (defined $error) {
+            error_redirect $error;
+        
+        # Else, save the data
+        } else {
+            $processor = new Selima::htc::Processor::NLIndex($POST);
+            $success = $processor->process;
+            success_redirect $success;
+        }
+    }
+    return;
+}
+
+# check_get: Check the GET arguments
+sub check_get() {
+    local ($_, %_);
+    my $error;
+    
+    # A form is requested
+    if (is_form) {
+        $_ = form_type;
+        # A form to create a new item
+        if ($_ eq "new") {
+            # Nothing to check on a new form
+        
+        # A form to edit a current item
+        } elsif ($_ eq "cur") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # A form to delete a current item
+        } elsif ($_ eq "del") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+            return {"msg"=>N_("This index item has [numerate,_1,a subitem,subitems].  It cannot be deleted.  To delete the index item, [numerate,_1,its subitem,all of its subitems] must first be deleted."),
+                    "margs"=>[$CURRENT{"subitemcount"}],
+                    "isform"=>0}
+                if $CURRENT{"subitemcount"} > 0;
+        
+        # Not a valid form
+        } else {
+            return {"msg"=>N_("Incorrect form: [_1]."),
+                    "margs"=>[$_],
+                    "isform"=>0};
+        }
+    }
+    # List handler handles its own error
+    # OK
+    return;
+}
+
+# check_post: Check the POSTed form
+sub check_post() {
+    local ($_, %_);
+    my ($checker, $error);
+    $_ = form_type;
+    # A form to create a new item
+    if ($_ eq "new") {
+        # Run the checker
+        $checker = new Selima::htc::Checker::NLIndex(curform);
+        $checker->redir(qw(selnewslet delnewslet selparent delparent selart delart));
+        $error = $checker->check(qw(newslet parent ord art title));
+        return $error if defined $error;
+    
+    # A form to edit a current item
+    } elsif ($_ eq "cur") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;
+        # Run the checker
+        $checker = new Selima::htc::Checker::NLIndex(curform);
+        $checker->redir(qw(del selnewslet delnewslet selparent delparent selart delart));
+        $error = $checker->check(qw(newslet parent ord art title));
+        return $error if defined $error;
+    
+    # A form to delete a current item
+    } elsif ($_ eq "del") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;
+        # Run the checker
+        $checker = new Selima::htc::Checker::NLIndex(curform);
+        $checker->redir(qw(cancel));
+        return {"msg"=>N_("This index item has [numerate,_1,a subitem,subitems].  It cannot be deleted.  To delete the index item, [numerate,_1,its subitem,all of its subitems] must first be deleted."),
+                "margs"=>[$CURRENT{"subitemcount"}],
+                "isform"=>0}
+            if $CURRENT{"subitemcount"} > 0;
+    
+    # Not a valid form
+    } else {
+        return {"msg"=>N_("Incorrect form: [_1]."),
+                "margs"=>[$_],
+                "isform"=>0};
+    }
+    # OK
+    return;
+}
+
+# html_page: Display the page
+sub html_page($) {
+    local ($_, %_);
+    my ($status, $LIST, $FORM);
+    $status = $_[0];
+    # A form is requested
+    if (is_form $status) {
+        $FORM = new Selima::htc::Form::NLIndex($status);
+        html_header $FORM->{"title"};
+        html_errmsg $status;
+        $FORM->html;
+        html_footer;
+    
+    # List the available items
+    } else {
+        $LIST = new Selima::htc::List::NLIndex;
+        html_header $LIST->{"title"}, $LIST->page_param;
+        html_errmsg $status;
+        $LIST->html;
+        html_footer;
+    }
+    return;
+}
+
+
+##################################
+# Subroutines to manage the data #
+##################################
+# fetch_curitem: Fetch the current item
+sub fetch_curitem() {
+    local ($_, %_);
+    my ($sn, $FORM, $sth, $sql, $row);
+    
+    # Return if fetched before
+    return if scalar(keys %CURRENT) > 0;
+    
+    # Obtain the current form
+    $FORM = curform;
+    # No item specified
+    return {"msg"=>N_("Please select the index item."),
+            "isform"=>0}
+        if !defined $FORM->param("sn");
+    $sn = $FORM->param("sn");
+    
+    # Find the record
+    %CURRENT = fetchrec $sn, $THIS_TABLE;
+    # If this record exist
+    return {"msg"=>N_("This index item does not exist anymore.  Please select another one."),
+            "isform"=>0}
+        if scalar(keys %CURRENT) == 0;
+    
+    # Obtain the belonging subitems list
+    @_ = qw();
+    push @_, "nlindex.sn AS sn";
+    push @_, "nlindex_fulltitle(parent, COALESCE(nlindex.title, nlarts.title)) AS title";
+    $sql = "SELECT " . join(", ", @_) . " FROM nlindex"
+        . " LEFT JOIN nlarts ON nlindex.art=nlarts.sn"
+        . " WHERE nlindex_ischild($sn, nlindex.sn)"
+        . " ORDER BY nlindex_fullord(nlindex.parent, nlindex.ord);\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    $CURRENT{"subitemcount"} = $sth->rows;
+    for ($_ = 0; $_ < $CURRENT{"subitemcount"}; $_++) {
+        $row = $sth->fetchrow_hashref;
+        $CURRENT{"subitem$_" . "sn"} = $$row{"sn"};
+        $CURRENT{"subitem$_" . "title"} = $$row{"title"};
+    }
+    
+    # OK
+    return;
+}
+
+# import_selnewslet: Import the selected newsletter into the retrieved form
+sub import_selnewslet($) {
+    local ($_, %_);
+    my $FORM;
+    $FORM = $_[0];
+    $FORM->param("newslet", $GET->param("selsn"))
+        if  defined $GET->param("selsn")
+            && check_sn_in ${$GET->param_fetch("selsn")}[0], "newslets";
+    return;
+}
+
+# import_selparent: Import the selected parent into the retrieved form
+sub import_selparent($) {
+    local ($_, %_);
+    my $FORM;
+    $FORM = $_[0];
+    if (    defined $GET->param("selsn")
+            && check_sn_in ${$GET->param_fetch("selsn")}[0], "nlindex") {
+        $FORM->param("parent", $GET->param("selsn"));
+        $FORM->param("topmost", "false");
+    }
+    return;
+}
+
+# import_selart: Import the selected article into the retrieved form
+sub import_selart($) {
+    local ($_, %_);
+    my $FORM;
+    $FORM = $_[0];
+    $FORM->param("art", $GET->param("selsn"))
+        if  defined $GET->param("selsn")
+            && check_sn_in ${$GET->param_fetch("selsn")}[0], "nlarts";
+    return;
+}

htdocs/htc/magicat/cgi-bin/pages.cgi

@@ -0,0 +1,221 @@
+#! /usr/bin/perl -w
+# History: Theory and Culture
+# pages.cgi: The web page administration.
+
+#  Copyright (c) 2006-2021 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-03
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::htc;
+local $SIG{"__DIE__"} = \&http_500;
+my $d = new Selima::Destroy;
+# Prototype declaration
+sub main();
+sub check_get();
+sub check_post();
+sub html_page($);
+sub fetch_curitem();
+
+initenv(-restricted => 1,
+        -this_table => "pages",
+        -dbi_lock   => {"pages"                 => LOCK_EX},
+        -lastmod    => 1,
+        -page_param => {"keywords"              => N_("pages")});
+
+main;
+exit 0;
+
+sub main() {
+    local ($_, %_);
+    my ($error, $success, $processor);
+    
+    # If the request is a GET query
+    if ($ENV{"REQUEST_METHOD"} ne "POST") {
+        $error = check_get;
+        # If an error occurs
+        if (defined $error) {
+            html_page $error;
+        
+        # Display the page
+        } else {
+            html_page retrieve_status;
+        }
+    
+    # If a form was POSTed from the client
+    } else {
+        $error = check_post;
+        # If an error occurs
+        if (defined $error) {
+            error_redirect $error;
+        
+        # Else, save the data
+        } else {
+            $processor = new Selima::Processor::Page($POST);
+            $success = $processor->process;
+            success_redirect $success;
+        }
+    }
+    return;
+}
+
+# check_get: Check the GET arguments
+sub check_get() {
+    local ($_, %_);
+    my $error;
+    
+    # A form is requested
+    if (is_form) {
+        $_ = form_type;
+        # A form to create a new item
+        if ($_ eq "new") {
+            # Nothing to check on a new form
+        
+        # A form to edit a current item
+        } elsif ($_ eq "cur") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # A form to delete a current item
+        } elsif ($_ eq "del") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # A form to preview a submitted item
+        } elsif ($_ eq "preview") {
+            # Check at fetch_preview()
+            $error = fetch_preview;
+            return $error if defined $error;
+        
+        # Not a valid form
+        } else {
+            return {"msg"=>N_("Incorrect form: [_1]."),
+                    "margs"=>[$_],
+                    "isform"=>0};
+        }
+    }
+    # List handler handles its own error
+    # OK
+    return;
+}
+
+# check_post: Check the POSTed form
+sub check_post() {
+    local ($_, %_);
+    my ($checker, $error);
+    $_ = form_type;
+    # A form to create a new item
+    if ($_ eq "new") {
+        # Run the checker
+        $checker = new Selima::Checker::Page(curform);
+        $error = $checker->check(qw(path ord title body kw));
+        return $error if defined $error;
+    
+    # A form to edit a current item
+    } elsif ($_ eq "cur") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;
+        # Run the checker
+        $checker = new Selima::Checker::Page(curform);
+        $checker->redir(qw(del));
+        $error = $checker->check(qw(path ord title body kw));
+        return $error if defined $error;
+    
+    # A form to delete a current item
+    } elsif ($_ eq "del") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;;
+        # Run the checker
+        $checker = new Selima::Checker::Page(curform);
+        $checker->redir(qw(cancel));
+    
+    # Not a valid form
+    } else {
+        return {"msg"=>N_("Incorrect form: [_1]."),
+                "margs"=>[$_],
+                "isform"=>0};
+    }
+    # OK
+    return;
+}
+
+# html_page: Display the page
+sub html_page($) {
+    local ($_, %_);
+    my ($status, $LIST, $FORM);
+    $status = $_[0];
+    # A form is requested
+    if (is_form $status) {
+        # A form to preview a submitted item
+        if (form_type eq "preview") {
+            html_preview;
+        
+        } else {
+            $FORM = new Selima::Form::Page($status);
+            html_header $FORM->{"title"};
+            html_errmsg $status;
+            $FORM->html;
+            html_footer;
+        }
+    
+    # List the available items
+    } else {
+        $LIST = new Selima::List::Pages;
+        html_header $LIST->{"title"}, $LIST->page_param;
+        html_errmsg $status;
+        $LIST->html;
+        html_footer;
+    }
+    return;
+}
+
+
+##################################
+# Subroutines to manage the data #
+##################################
+# fetch_curitem: Fetch the current item
+sub fetch_curitem() {
+    local ($_, %_);
+    my ($sn, $FORM);
+    
+    # Return if fetched before
+    return if scalar(keys %CURRENT) > 0;
+    
+    # Obtain the current form
+    $FORM = curform;
+    # No item specified
+    return {"msg"=>N_("Please select the page."),
+            "isform"=>0}
+        if !defined $FORM->param("sn");
+    $sn = $FORM->param("sn");
+    
+    # Find the record
+    %CURRENT = fetchrec $sn, $THIS_TABLE;
+    # If this record exist
+    return {"msg"=>N_("This page does not exist anymore.  Please select another one."),
+            "isform"=>0}
+        if scalar(keys %CURRENT) == 0;
+    
+    # OK
+    return;
+}

htdocs/htc/magicat/cgi-bin/rebuild.cgi

@@ -0,0 +1,105 @@
+#! /usr/bin/perl -w
+# History: Theory and Culture
+# rebuild.cgi: The web page rebuilder.
+
+#  Copyright (c) 2006-2021 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
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::htc;
+local $SIG{"__DIE__"} = \&http_500;
+my $d = new Selima::Destroy;
+# Prototype declaration
+sub main();
+sub check_get();
+sub check_post();
+sub html_page($);
+
+initenv(-restricted => 1,
+        -lastmod    => 1,
+        -page_param => {"keywords"              => N_("rebuild pages")});
+
+main;
+exit 0;
+
+sub main() {
+    local ($_, %_);
+    my ($error, $success, $processor);
+    
+    # If the request is a GET query
+    if ($ENV{"REQUEST_METHOD"} ne "POST") {
+        $error = check_get;
+        # If an error occurs
+        if (defined $error) {
+            html_page $error;
+        
+        # Display the page
+        } else {
+            html_page retrieve_status;
+        }
+    
+    # If a form was POSTed from the client
+    } else {
+        $error = check_post;
+        # If an error occurs
+        if (defined $error) {
+            error_redirect $error;
+        
+        # Else, save the data
+        } else {
+            $processor = new Selima::Processor::Rebuild($POST);
+            $success = $processor->process;
+            success_redirect $success;
+        }
+    }
+    return;
+}
+
+# check_get: Check the GET arguments
+sub check_get() {
+    # Nothing to check here
+    # OK
+    return;
+}
+
+# check_post: Check the POSTed form
+sub check_post() {
+    local ($_, %_);
+    my ($checker, $error);
+    # Run the checker
+    $checker = new Selima::Checker::Rebuild(curform);
+    $error = $checker->check(qw(type));
+    return $error if defined $error;
+    # OK
+    return;
+}
+
+# html_page: Display the page
+sub html_page($) {
+    local ($_, %_);
+    my ($status, $FORM);
+    $status = $_[0];
+    $FORM = new Selima::Form::Rebuild($status);
+    html_header $FORM->{"title"};
+    html_errmsg $status;
+    $FORM->html;
+    html_footer;
+    return;
+}

htdocs/htc/magicat/cgi-bin/scptpriv.cgi

@@ -0,0 +1,223 @@
+#! /usr/bin/perl -w
+# History: Theory and Culture
+# scptpriv.cgi: The script privilege administration.
+
+#  Copyright (c) 2004-2021 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2004-10-16
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::htc;
+local $SIG{"__DIE__"} = \&http_500;
+my $d = new Selima::Destroy;
+# Prototype declaration
+sub main();
+sub check_get();
+sub check_post();
+sub html_page($);
+sub fetch_curitem();
+sub import_selgrp($);
+
+initenv(-restricted => 1,
+        -this_table => "scptpriv",
+        -dbi_lock   => {"scptpriv"              => LOCK_EX,
+                        "groups"                => LOCK_SH},
+        -lastmod    => 1,
+        -page_param => {"keywords"              => N_("script privilege")});
+
+main;
+exit 0;
+
+sub main() {
+    local ($_, %_);
+    my ($error, $success, $processor);
+    
+    # If the request is a GET query
+    if ($ENV{"REQUEST_METHOD"} ne "POST") {
+        $error = check_get;
+        # If an error occurs
+        if (defined $error) {
+            html_page $error;
+        
+        # Display the page
+        } else {
+            html_page retrieve_status;
+        }
+    
+    # If a form was POSTed from the client
+    } else {
+        $error = check_post;
+        # If an error occurs
+        if (defined $error) {
+            error_redirect $error;
+        
+        # Else, save the data
+        } else {
+            $processor = new Selima::Processor::ScptPriv($POST);
+            $success = $processor->process;
+            success_redirect $success;
+        }
+    }
+    return;
+}
+
+# check_get: Check the GET arguments
+sub check_get() {
+    local ($_, %_);
+    my $error;
+    
+    # A form is requested
+    if (is_form) {
+        $_ = form_type;
+        # A form to create a new item
+        if ($_ eq "new") {
+            # Nothing to check on a new form
+        
+        # A form to edit a current item
+        } elsif ($_ eq "cur") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # A form to delete a current item
+        } elsif ($_ eq "del") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # Not a valid form
+        } else {
+            return {"msg"=>N_("Incorrect form: [_1]."),
+                    "margs"=>[$_],
+                    "isform"=>0};
+        }
+    }
+    # List handler handles its own error
+    # OK
+    return;
+}
+
+# check_post: Check the POSTed form
+sub check_post() {
+    local ($_, %_);
+    my ($checker, $error);
+    $_ = form_type;
+    # A form to create a new item
+    if ($_ eq "new") {
+        # Run the checker
+        $checker = new Selima::Checker::ScptPriv(curform);
+        $checker->redir(qw(selgrp delgrp));
+        $error = $checker->check(qw(script grp));
+        return $error if defined $error;
+    
+    # A form to edit a current item
+    } elsif ($_ eq "cur") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;
+        # Run the checker
+        $checker = new Selima::Checker::ScptPriv(curform);
+        $checker->redir(qw(del selgrp delgrp));
+        $error = $checker->check(qw(script grp));
+        return $error if defined $error;
+    
+    # A form to delete a current item
+    } elsif ($_ eq "del") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;;
+        # Run the checker
+        $checker = new Selima::Checker::ScptPriv(curform);
+        $checker->redir(qw(cancel));
+    
+    # Not a valid form
+    } else {
+        return {"msg"=>N_("Incorrect form: [_1]."),
+                "margs"=>[$_],
+                "isform"=>0};
+    }
+    # OK
+    return;
+}
+
+# html_page: Display the page
+sub html_page($) {
+    local ($_, %_);
+    my ($status, $LIST, $FORM);
+    $status = $_[0];
+    # A form is requested
+    if (is_form $status) {
+        $FORM = new Selima::Form::ScptPriv($status);
+        html_header $FORM->{"title"};
+        html_errmsg $status;
+        $FORM->html;
+        html_footer;
+    
+    # List the available items
+    } else {
+        $LIST = new Selima::List::ScptPriv;
+        html_header $LIST->{"title"}, $LIST->page_param;
+        html_errmsg $status;
+        $LIST->html;
+        html_footer;
+    }
+    return;
+}
+
+
+##################################
+# Subroutines to manage the data #
+##################################
+# fetch_curitem: Fetch the current item
+sub fetch_curitem() {
+    local ($_, %_);
+    my ($sn, $FORM);
+    
+    # Return if fetched before
+    return if scalar(keys %CURRENT) > 0;
+    
+    # Obtain the current form
+    $FORM = curform;
+    # No item specified
+    return {"msg"=>N_("Please select the script privilege record."),
+            "isform"=>0}
+        if !defined $FORM->param("sn");
+    $sn = $FORM->param("sn");
+    
+    # Find the record
+    %CURRENT = fetchrec $sn, $THIS_TABLE;
+    # If this record exist
+    return {"msg"=>N_("This script privilege record does not exist anymore.  Please select another one."),
+            "isform"=>0}
+        if scalar(keys %CURRENT) == 0;
+    
+    # OK
+    return;
+}
+
+# import_selgrp: Import the selected group into the retrieved form
+sub import_selgrp($) {
+    local ($_, %_);
+    my $FORM;
+    $FORM = $_[0];
+    $FORM->param("grp", $GET->param("selsn"))
+        if  defined $GET->param("selsn")
+            && check_sn_in ${$GET->param_fetch("selsn")}[0], "groups";
+    return;
+}

htdocs/htc/magicat/cgi-bin/test.cgi

@@ -0,0 +1,40 @@
+#! /usr/bin/perl -w
+# History: Theory and Culture
+# test.cgi: The test script.
+
+#  Copyright (c) 2004-2021 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2004-11-02
+
+use 5.008;
+use utf8;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::htc;
+local $SIG{"__DIE__"} = \&http_500;
+my $r = shift;
+my $d = new Selima::Destroy;
+# Prototype declaration
+use Time::HiRes qw();
+initenv;
+$CONTENT_TYPE = "text/plain";
+
+
+printf "[%s] Done.  %0.10f seconds elapsed.\n",
+    fmttime, Time::HiRes::time-$T_START;
+exit 0;
+no utf8;

htdocs/htc/magicat/cgi-bin/usermem.cgi

@@ -0,0 +1,236 @@
+#! /usr/bin/perl -w
+# History: Theory and Culture
+# usermem.cgi: The user-to-group membership administration.
+
+#  Copyright (c) 2004-2021 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2004-10-16
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::htc;
+local $SIG{"__DIE__"} = \&http_500;
+my $d = new Selima::Destroy;
+# Prototype declaration
+sub main();
+sub check_get();
+sub check_post();
+sub html_page($);
+sub fetch_curitem();
+sub import_selgrp($);
+sub import_selmember($);
+
+initenv(-restricted => 1,
+        -this_table => "usermem",
+        -dbi_lock   => {"usermem"               => LOCK_EX,
+                        "groups"                => LOCK_SH,
+                        "users AS usrmembers"   => LOCK_SH},
+        -lastmod    => 1,
+        -page_param => {"keywords"              => N_("user membership")});
+
+main;
+exit 0;
+
+sub main() {
+    local ($_, %_);
+    my ($error, $success, $processor);
+    
+    # If the request is a GET query
+    if ($ENV{"REQUEST_METHOD"} ne "POST") {
+        $error = check_get;
+        # If an error occurs
+        if (defined $error) {
+            html_page $error;
+        
+        # Display the page
+        } else {
+            html_page retrieve_status;
+        }
+    
+    # If a form was POSTed from the client
+    } else {
+        $error = check_post;
+        # If an error occurs
+        if (defined $error) {
+            error_redirect $error;
+        
+        # Else, save the data
+        } else {
+            $processor = new Selima::Processor::UserMem($POST);
+            $success = $processor->process;
+            success_redirect $success;
+        }
+    }
+    return;
+}
+
+# check_get: Check the GET arguments
+sub check_get() {
+    local ($_, %_);
+    my $error;
+    
+    # A form is requested
+    if (is_form) {
+        $_ = form_type;
+        # A form to create a new item
+        if ($_ eq "new") {
+            # Nothing to check on a new form
+        
+        # A form to edit a current item
+        } elsif ($_ eq "cur") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # A form to delete a current item
+        } elsif ($_ eq "del") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # Not a valid form
+        } else {
+            return {"msg"=>N_("Incorrect form: [_1]."),
+                    "margs"=>[$_],
+                    "isform"=>0};
+        }
+    }
+    # List handler handles its own error
+    # OK
+    return;
+}
+
+# check_post: Check the POSTed form
+sub check_post() {
+    local ($_, %_);
+    my ($checker, $error);
+    $_ = form_type;
+    # A form to create a new item
+    if ($_ eq "new") {
+        # Run the checker
+        $checker = new Selima::Checker::UserMem(curform);
+        $checker->redir(qw(selgrp delgrp selmember delmember));
+        $error = $checker->check(qw(grp member));
+        return $error if defined $error;
+    
+    # A form to edit a current item
+    } elsif ($_ eq "cur") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;
+        # Run the checker
+        $checker = new Selima::Checker::UserMem(curform);
+        $checker->redir(qw(del selgrp delgrp selmember delmember));
+        $error = $checker->check(qw(grp member));
+        return $error if defined $error;
+    
+    # A form to delete a current item
+    } elsif ($_ eq "del") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;;
+        # Run the checker
+        $checker = new Selima::Checker::UserMem(curform);
+        $checker->redir(qw(cancel));
+    
+    # Not a valid form
+    } else {
+        return {"msg"=>N_("Incorrect form: [_1]."),
+                "margs"=>[$_],
+                "isform"=>0};
+    }
+    # OK
+    return;
+}
+
+# html_page: Display the page
+sub html_page($) {
+    local ($_, %_);
+    my ($status, $LIST, $FORM);
+    $status = $_[0];
+    # A form is requested
+    if (is_form $status) {
+        $FORM = new Selima::Form::UserMem($status);
+        html_header $FORM->{"title"};
+        html_errmsg $status;
+        $FORM->html;
+        html_footer;
+    
+    # List the available items
+    } else {
+        $LIST = new Selima::List::UserMem;
+        html_header $LIST->{"title"}, $LIST->page_param;
+        html_errmsg $status;
+        $LIST->html;
+        html_footer;
+    }
+    return;
+}
+
+
+##################################
+# Subroutines to manage the data #
+##################################
+# fetch_curitem: Fetch the current item
+sub fetch_curitem() {
+    local ($_, %_);
+    my ($sn, $FORM);
+    
+    # Return if fetched before
+    return if scalar(keys %CURRENT) > 0;
+    
+    # Obtain the current form
+    $FORM = curform;
+    # No item specified
+    return {"msg"=>N_("Please select the membership record."),
+            "isform"=>0}
+        if !defined $FORM->param("sn");
+    $sn = $FORM->param("sn");
+    
+    # Find the record
+    %CURRENT = fetchrec $sn, $THIS_TABLE;
+    # If this record exist
+    return {"msg"=>N_("This membership record does not exist anymore.  Please select another one."),
+            "isform"=>0}
+        if scalar(keys %CURRENT) == 0;
+    
+    # OK
+    return;
+}
+
+# import_selgrp: Import the selected group into the retrieved form
+sub import_selgrp($) {
+    local ($_, %_);
+    my $FORM;
+    $FORM = $_[0];
+    $FORM->param("grp", $GET->param("selsn"))
+        if  defined $GET->param("selsn")
+            && check_sn_in ${$GET->param_fetch("selsn")}[0], "groups";
+    return;
+}
+
+# import_selmember: Import the selected user into the retrieved form
+sub import_selmember($) {
+    local ($_, %_);
+    my $FORM;
+    $FORM = $_[0];
+    $FORM->param("member", $GET->param("selsn"))
+        if  defined $GET->param("selsn")
+            && check_sn_in ${$GET->param_fetch("selsn")}[0], "users AS usrmembers";
+    return $FORM;
+}

htdocs/htc/magicat/cgi-bin/userpref.cgi

@@ -0,0 +1,225 @@
+#! /usr/bin/perl -w
+# History: Theory and Culture
+# userpref.cgi: The user preference administration.
+
+#  Copyright (c) 2004-2021 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2004-10-16
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::htc;
+local $SIG{"__DIE__"} = \&http_500;
+my $d = new Selima::Destroy;
+# Prototype declaration
+sub main();
+sub check_get();
+sub check_post();
+sub html_page($);
+sub fetch_curitem();
+sub import_selusr($);
+
+initenv(-restricted => 1,
+        -this_table => "userpref",
+        -dbi_lock   => {"userpref"              => LOCK_EX,
+                        "users"                 => LOCK_SH},
+        -lastmod    => 1,
+        -page_param => {"keywords"              => N_("user preference")});
+
+main;
+exit 0;
+
+sub main() {
+    local ($_, %_);
+    my ($error, $success, $processor);
+    
+    # If the request is a GET query
+    if ($ENV{"REQUEST_METHOD"} ne "POST") {
+        $error = check_get;
+        # If an error occurs
+        if (defined $error) {
+            html_page $error;
+        
+        # Display the page
+        } else {
+            html_page retrieve_status;
+        }
+    
+    # If a form was POSTed from the client
+    } else {
+        $error = check_post;
+        # If an error occurs
+        if (defined $error) {
+            error_redirect $error;
+        
+        # Else, save the data
+        } else {
+            $processor = new Selima::Processor::UserPref($POST);
+            $success = $processor->process;
+            success_redirect $success;
+        }
+    }
+    return;
+}
+
+# check_get: Check the GET arguments
+sub check_get() {
+    local ($_, %_);
+    my $error;
+    
+    # A form is requested
+    if (is_form) {
+        $_ = form_type;
+        # A form to create a new item
+        if ($_ eq "new") {
+            # Nothing to check on a new form
+        
+        # A form to edit a current item
+        } elsif ($_ eq "cur") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # A form to delete a current item
+        } elsif ($_ eq "del") {
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # Not a valid form
+        } else {
+            return {"msg"=>N_("Incorrect form: [_1]."),
+                    "margs"=>[$_],
+                    "isform"=>0};
+        }
+    }
+    # List handler handles its own error
+    # OK
+    return;
+}
+
+# check_post: Check the POSTed form
+sub check_post() {
+    local ($_, %_);
+    my ($checker, $error);
+    $_ = form_type;
+    # A form to create a new item
+    if ($_ eq "new") {
+        # Run the checker
+        $checker = new Selima::Checker::UserPref(curform);
+        $checker->redir(qw(selusr delusr));
+        $error = $checker->check(qw(usr domain name value));
+        return $error if defined $error;
+    
+    # A form to edit a current item
+    } elsif ($_ eq "cur") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;
+        # Run the checker
+        $checker = new Selima::Checker::UserPref(curform);
+        $checker->redir(qw(del selusr delusr));
+        $error = $checker->check(qw(usr domain name value));
+        return $error if defined $error;
+    
+    # A form to delete a current item
+    } elsif ($_ eq "del") {
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;;
+        # Run the checker
+        $checker = new Selima::Checker::UserPref(curform);
+        $checker->redir(qw(cancel));
+    
+    # Not a valid form
+    } else {
+        return {"msg"=>N_("Incorrect form: [_1]."),
+                "margs"=>[$_],
+                "isform"=>0};
+    }
+    # OK
+    return;
+}
+
+# html_page: Display the page
+sub html_page($) {
+    local ($_, %_);
+    my ($status, $LIST, $FORM);
+    $status = $_[0];
+    # A form is requested
+    if (is_form $status) {
+        $FORM = new Selima::Form::UserPref($status);
+        html_header $FORM->{"title"};
+        html_errmsg $status;
+        $FORM->html;
+        html_footer;
+    
+    # List the available items
+    } else {
+        $LIST = new Selima::List::UserPref;
+        html_header $LIST->{"title"}, $LIST->page_param;
+        html_errmsg $status;
+        $LIST->html;
+        html_footer;
+    }
+    return;
+}
+
+
+##################################
+# Subroutines to manage the data #
+##################################
+# fetch_curitem: Fetch the current item
+sub fetch_curitem() {
+    local ($_, %_);
+    my ($sn, $FORM);
+    
+    # Return if fetched before
+    return if scalar(keys %CURRENT) > 0;
+    
+    # Obtain the current form
+    $FORM = curform;
+    # No item specified
+    return {"msg"=>N_("Please select the user preference."),
+            "isform"=>0}
+        if !defined $FORM->param("sn");
+    $sn = $FORM->param("sn");
+    
+    # Find the record
+    %CURRENT = fetchrec $sn, $THIS_TABLE;
+    # If this record exist
+    return {"msg"=>N_("This user preference does not exist anymore.  Please select another one."),
+            "isform"=>0}
+        if scalar(keys %CURRENT) == 0;
+    
+    # OK
+    return;
+}
+
+# import_selusr: Import the selected user into the retrieved form
+sub import_selusr($) {
+    local ($_, %_);
+    my $FORM;
+    $FORM = $_[0];
+    if (    defined $GET->param("selsn")
+            && check_sn_in ${$GET->param_fetch("selsn")}[0], "users") {
+        $FORM->param("usr", $GET->param("selsn"));
+        $FORM->param("everyone", "false");
+    }
+    return;
+}

htdocs/htc/magicat/cgi-bin/users.cgi

@@ -0,0 +1,273 @@
+#! /usr/bin/perl -w
+# History: Theory and Culture
+# users.cgi: The user account administration.
+
+#  Copyright (c) 2004-2021 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2004-10-16
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::htc;
+local $SIG{"__DIE__"} = \&http_500;
+my $d = new Selima::Destroy;
+# Prototype declaration
+sub main();
+sub check_get();
+sub check_post();
+sub html_page($);
+sub fetch_curitem();
+
+initenv(-this_table => "users",
+        -dbi_lock   => {"users"                 => LOCK_EX,
+                        "usermem"               => LOCK_EX,
+                        "userpref"              => LOCK_EX,
+                        "groupmem"              => LOCK_SH,
+                        "groups"                => LOCK_SH},
+        -lastmod    => 1,
+        -page_param => {"keywords"              => N_("users")});
+
+main;
+exit 0;
+
+sub main() {
+    local ($_, %_);
+    my ($error, $success, $processor);
+    
+    # If the request is a GET query
+    if ($ENV{"REQUEST_METHOD"} ne "POST") {
+        $error = check_get;
+        # If an error occurs
+        if (defined $error) {
+            html_page $error;
+        
+        # Display the page
+        } else {
+            html_page retrieve_status;
+        }
+    
+    # If a form was POSTed from the client
+    } else {
+        $error = check_post;
+        # If an error occurs
+        if (defined $error) {
+            # Password not saved
+            $POST->delete("passwd", "passwd2");
+            error_redirect $error;
+        
+        # Else, save the data
+        } else {
+            $processor = new Selima::Processor::User($POST);
+            $success = $processor->process;
+            # Password not saved
+            $POST->delete("passwd", "passwd2");
+            success_redirect $success;
+        }
+    }
+    return;
+}
+
+# check_get: Check the GET arguments
+sub check_get() {
+    local ($_, %_);
+    my ($error, $FORM, $sn);
+    
+    # A form is requested
+    if (is_form) {
+        $_ = form_type;
+        # A form to create a new item
+        if ($_ eq "new") {
+            # Check the privilege to manage this table
+            unauth if !is_script_permitted;
+        
+        # A form to edit a current item
+        } elsif ($_ eq "cur") {
+            # Check the privilege to manage this table
+            $FORM = curform;
+            $sn = defined $FORM->param("sn")? $FORM->param("sn"): -1;
+            unauth unless defined get_login_sn;
+            unauth unless is_script_permitted || $sn == get_login_sn;
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # A form to delete a current item
+        } elsif ($_ eq "del") {
+            # Check the privilege to manage this table
+            $FORM = curform;
+            $sn = defined $FORM->param("sn")? $FORM->param("sn"): -1;
+            unauth unless defined get_login_sn;
+            unauth unless is_script_permitted;
+            unauth if !is_su && (is_su $sn || $sn == get_login_sn);
+            # Check at fetch_curitem()
+            $error = fetch_curitem;
+            return $error if defined $error;
+        
+        # Not a valid form
+        } else {
+            # Check the privilege to manage this table
+            unauth unless is_script_permitted;
+            return {"msg"=>N_("Incorrect form: [_1]."),
+                    "margs"=>[$_],
+                    "isform"=>0};
+        }
+    
+    # List the available items
+    } else {
+        # Check the privilege to manage this table
+        unauth unless is_script_permitted;
+        # List handler handles its own error
+    }
+    # OK
+    return;
+}
+
+# check_post: Check the POSTed form
+sub check_post() {
+    local ($_, %_);
+    my ($checker, $error, $FORM, $sn);
+    $_ = form_type;
+    # A form to create a new item
+    if ($_ eq "new") {
+        # Check the privilege to manage this table
+        unauth unless is_script_permitted;
+        # Run the checker
+        $checker = new Selima::Checker::User(curform);
+        $error = $checker->check(qw(id passwd name supgroup));
+        return $error if defined $error;
+    
+    # A form to edit a current item
+    } elsif ($_ eq "cur") {
+        # Check the privilege to manage this table
+        $FORM = curform;
+        $sn = defined $FORM->param("sn")? $FORM->param("sn"): -1;
+        unauth unless defined get_login_sn;
+        unauth unless is_script_permitted || $sn == get_login_sn;
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;
+        # Run the checker
+        $checker = new Selima::Checker::User(curform);
+        $checker->redir(qw(del));
+        $error = $checker->check(qw(id passwd name supgroup));
+        return $error if defined $error;
+    
+    # A form to delete a current item
+    } elsif ($_ eq "del") {
+        # Check the privilege to manage this table
+        $FORM = curform;
+        $sn = defined $FORM->param("sn")? $FORM->param("sn"): -1;
+        unauth unless defined get_login_sn;
+        unauth unless is_script_permitted;
+        unauth if !is_su && (is_su $sn || $sn == get_login_sn);
+        # Check at fetch_curitem()
+        $error = fetch_curitem;
+        return $error if defined $error;;
+        # Run the checker
+        $checker = new Selima::Checker::User(curform);
+        $checker->redir(qw(cancel));
+    
+    # Not a valid form
+    } else {
+        # Check the privilege to manage this table
+        unauth unless is_script_permitted;
+        return {"msg"=>N_("Incorrect form: [_1]."),
+                "margs"=>[$_],
+                "isform"=>0};
+    }
+    # OK
+    return;
+}
+
+# html_page: Display the page
+sub html_page($) {
+    local ($_, %_);
+    my ($status, $LIST, $FORM);
+    $status = $_[0];
+    # A form is requested
+    if (is_form $status) {
+        $FORM = new Selima::Form::User($status);
+        html_header $FORM->{"title"};
+        html_errmsg $status;
+        $FORM->html;
+        html_footer;
+    
+    # List the available items
+    } else {
+        $LIST = new Selima::List::Users;
+        html_header $LIST->{"title"}, $LIST->page_param;
+        html_errmsg $status;
+        $LIST->html;
+        html_footer;
+    }
+    return;
+}
+
+
+##################################
+# Subroutines to manage the data #
+##################################
+# fetch_curitem: Fetch the current item
+sub fetch_curitem() {
+    local ($_, %_);
+    my ($sn, $FORM, $sth, $sql, $row);
+    
+    # Return if fetched before
+    return if scalar(keys %CURRENT) > 0;
+    
+    # Obtain the current form
+    $FORM = curform;
+    # No item specified
+    return {"msg"=>N_("Please select the user."),
+            "isform"=>0}
+        if !defined $FORM->param("sn");
+    $sn = $FORM->param("sn");
+    
+    # Find the record
+    %CURRENT = fetchrec $sn, $THIS_TABLE;
+    # If this record exist
+    return {"msg"=>N_("This user does not exist anymore.  Please select another one."),
+            "isform"=>0}
+        if scalar(keys %CURRENT) == 0;
+    
+    # Obtain the belonging groups list
+    $sql = "SELECT groups.sn AS sn,"
+        . " groups.dsc AS title FROM usermem"
+        . " INNER JOIN groups ON usermem.grp=groups.sn"
+        . " WHERE usermem.member=$sn"
+        . " AND groups.id!=" . $DBH->quote(SU_GROUP)
+        . " AND groups.id!=" . $DBH->quote(ADMIN_GROUP)
+        . " AND groups.id!=" . $DBH->quote(ALLUSERS_GROUP)
+        . " ORDER BY groups.id;\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    $CURRENT{"supgroupcount"} = $sth->rows;
+    for ($_ = 0; $_ < $CURRENT{"supgroupcount"}; $_++) {
+        $row = $sth->fetchrow_hashref;
+        $CURRENT{"supgroup$_"} = 1;
+        $CURRENT{"supgroup$_" . "sn"} = $$row{"sn"};
+        $CURRENT{"supgroup$_" . "title"} = $$row{"title"};
+    }
+    
+    # Get the admin flag
+    $CURRENT{"admin"} = is_admin($sn);
+    $CURRENT{"su"} = is_su($sn);
+    
+    # OK
+    return;
+}