Initial commit.

htdocs/emandy/magicat/cgi-bin/acctrecs.cgi

@@ -0,0 +1,242 @@
+#! /usr/bin/perl -w
+# Mandy Wu's Website
+# acctrecs.cgi: The accounting record administration.
+
+#  Copyright (c) 2007-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: 2007-09-24
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::emandy;
+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_seltrx($);
+sub import_selsubj($);
+
+initenv(-restricted => 1,
+        -this_table => "acctrecs",
+        -dbi_lock   => {"acctrecs"              => LOCK_EX,
+                        "accttrx"               => LOCK_SH,
+                        "acctsubj"              => LOCK_SH},
+        -lastmod    => 1,
+        -page_param => {"keywords"              => N_("accounting")});
+
+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::AcctRec($POST);
+            $success = $processor->process;
+            success_redirect $success;
+        }
+    }
+    return;
+}
+
+# check_get: Check the GET arguments
+sub check_get() {
+    local ($_, %_);
+    my $error;
+    # Only allowing to run on HTTPS
+    http_403 if !is_https;
+    
+    # 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);
+    # Only allowing to run on HTTPS
+    http_403 if !is_https;
+    $_ = form_type;
+    # A form to create a new item
+    if ($_ eq "new") {
+        # Run the checker
+        $checker = new Selima::Checker::AcctRec(curform);
+        $checker->redir(qw(seltrx deltrx selsubj delsubj));
+        $error = $checker->check(qw(trx type ord subj summary amount));
+        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::AcctRec(curform);
+        $checker->redir(qw(del seltrx deltrx selsubj delsubj));
+        $error = $checker->check(qw(trx type ord subj summary amount));
+        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::AcctRec(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::AcctRec($status);
+        html_header $FORM->{"title"};
+        html_errmsg $status;
+        $FORM->html;
+        html_footer;
+    
+    # List the available items
+    } else {
+        $LIST = new Selima::List::Accounting::Records;
+        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);
+    
+    # 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 accounting 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 accounting record does not exist anymore.  Please select another one."),
+            "isform"=>0}
+        if scalar(keys %CURRENT) == 0;
+    
+    $CURRENT{"type"} = $CURRENT{"credit"}? "credit": "debit";
+    
+    # OK
+    return;
+}
+
+# import_seltrx: Import the selected accounting transaction into the retrieved form
+sub import_seltrx($) {
+    local ($_, %_);
+    my $FORM;
+    $FORM = $_[0];
+    $FORM->param("trx", $GET->param("selsn"))
+        if  defined $GET->param("selsn")
+            && check_sn_in ${$GET->param_fetch("selsn")}[0], "accttrx";
+    return;
+}
+
+# import_selsubj: Import the selected accounting subject into the retrieved form
+sub import_selsubj($) {
+    local ($_, %_);
+    my $FORM;
+    $FORM = $_[0];
+    $FORM->param("subj", $GET->param("selsn"))
+        if  defined $GET->param("selsn")
+            && check_sn_in ${$GET->param_fetch("selsn")}[0], "acctsubj";
+    return;
+}

htdocs/emandy/magicat/cgi-bin/acctreps.cgi

@@ -0,0 +1,107 @@
+#! /usr/bin/perl -w
+# Mandy Wu's Website
+# acctreps.cgi: The accounting report viewer.
+
+#  Copyright (c) 2007-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: 2007-09-24
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::emandy;
+local $SIG{"__DIE__"} = \&http_500;
+my $d = new Selima::Destroy;
+# Prototype declaration
+sub main();
+sub check_get();
+sub html_page($);
+
+initenv(-restricted => 1,
+        -dbi_lock   => {"acctsubj"              => LOCK_SH,
+                        "accttrx"               => LOCK_SH,
+                        "acctrecs"              => LOCK_SH},
+        -lastmod    => 1,
+        -page_param => {"keywords"              => N_("accounting"),
+                        "javascripts"   => [qw(/scripts/accounting.js)]});
+
+main;
+exit 0;
+
+sub main() {
+    local ($_, %_);
+    my $error;
+    # Only allowing requests with GET method
+    # Check it here, since we still want list preference handlers to work
+    http_405 qw(GET) if $ENV{"REQUEST_METHOD"} ne "GET";
+    $error = check_get;
+    # If an error occurs
+    if (defined $error) {
+        html_page $error;
+    
+    # Display the page
+    } else {
+        html_page retrieve_status;
+    }
+    return;
+}
+
+# check_get: Check the GET arguments
+sub check_get() {
+    local ($_, %_);
+    # Only allowing to run on HTTPS
+    http_403 if !is_https;
+    # List handler handles its own error
+    # OK
+    return;
+}
+
+# html_page: Display the page
+sub html_page($) {
+    local ($_, %_);
+    my ($status, $LIST, $page_param);
+    $status = $_[0];
+    # List the available items
+    $_ = list_type;
+    if ($_ eq "cashsum") {
+        $LIST = new Selima::List::Accounting::Reports::Cash::Summary;
+    } elsif ($_ eq "ldgr") {
+        $LIST = new Selima::List::Accounting::Reports::Ledger;
+    } elsif ($_ eq "ldgrsum") {
+        $LIST = new Selima::List::Accounting::Reports::Ledger::Summary;
+    } elsif ($_ eq "journal") {
+        $LIST = new Selima::List::Accounting::Reports::Journal;
+    } elsif ($_ eq "tb") {
+        $LIST = new Selima::List::Accounting::Reports::TriBlnc;
+    } elsif ($_ eq "incmstat") {
+        $LIST = new Selima::List::Accounting::Reports::IncmStat;
+    } elsif ($_ eq "blncshet") {
+        $LIST = new Selima::List::Accounting::Reports::BlncShet;
+    } elsif ($_ eq "search") {
+        $LIST = new Selima::List::Accounting::Reports::Search;
+    } else {
+        $LIST = new Selima::List::Accounting::Reports::Cash;
+    }
+    # Return the data as a CSV file
+    return $LIST->html if $LIST->{"iscsv"};
+    # Ordinary list
+    html_header $LIST->{"title"}, $LIST->page_param;
+    html_errmsg $status;
+    $LIST->html;
+    html_footer;
+    return;
+}

htdocs/emandy/magicat/cgi-bin/acctsubj.cgi

@@ -0,0 +1,292 @@
+#! /usr/bin/perl -w
+# Mandy Wu's Website
+# acctsubj.cgi: The accounting subject administraion.
+
+#  Copyright (c) 2007-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: 2007-09-24
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::emandy;
+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 => "acctsubj",
+        -dbi_lock   => {"acctsubj"              => LOCK_EX,
+                        "acctrecs"              => LOCK_SH},
+        -lastmod    => 1,
+        -page_param => {"keywords"              => N_("accounting")});
+
+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::AcctSubj($POST);
+            $success = $processor->process;
+            success_redirect $success;
+        }
+    }
+    return;
+}
+
+# check_get: Check the GET arguments
+sub check_get() {
+    local ($_, %_);
+    my $error;
+    # Only allowing to run on HTTPS
+    http_403 if !is_https;
+    
+    # A form is requested
+    if (is_form) {
+        $_ = form_type;
+        # A form to create a new item
+        if ($_ eq "new") {
+            # Start from the default language
+            return {"msg"=>N_("Please add a new accounting subject from [_1]."),
+                    "margs"=>["_DEFAULT_LANG"],
+                    "isform"=>0}
+                if getlang ne $DEFAULT_LANG;
+        
+        # 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 accounting subject has [numerate,_1,an accounting sub-subject,accounting sub-subjects].  It cannot be deleted.  To delete the subject, [numerate,_1,its accounting sub-subject,all of its accounting sub-subjects] must first be deleted."),
+                    "margs"=>[$CURRENT{"ssubcount"}],
+                    "isform"=>0}
+                if $CURRENT{"ssubcount"} > 0;
+            return {"msg"=>N_("This accounting subject has [numerate,_1,an accounting record,accounting records].  It cannot be deleted.  To delete the subject, [numerate,_1,its accounting record,all of its accounting records] must first be deleted."),
+                    "margs"=>[$CURRENT{"reccount"}],
+                    "isform"=>0}
+                if $CURRENT{"reccount"} > 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);
+    # Only allowing to run on HTTPS
+    http_403 if !is_https;
+    $_ = form_type;
+    # A form to create a new item
+    if ($_ eq "new") {
+        # Start from the default language
+        return {"msg"=>N_("Please add a new accounting subject from [_1]."),
+                "margs"=>["_DEFAULT_LANG"],
+                "isform"=>0}
+            if getlang ne $DEFAULT_LANG;
+        # Run the checker
+        $checker = new Selima::Checker::AcctSubj(curform);
+        $checker->redir(qw(selparent delparent));
+        $error = $checker->check(qw(parent code 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::Checker::AcctSubj(curform);
+        $checker->redir(qw(del zhsync selparent delparent));
+        $error = $checker->check(qw(parent code 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::Checker::AcctSubj(curform);
+        $checker->redir(qw(cancel));
+        return {"msg"=>N_("This accounting subject has [numerate,_1,an accounting sub-subject,accounting sub-subjects].  It cannot be deleted.  To delete the subject, [numerate,_1,its accounting sub-subject,all of its accounting sub-subjects] must first be deleted."),
+                "margs"=>[$CURRENT{"ssubcount"}],
+                "isform"=>0}
+            if $CURRENT{"ssubcount"} > 0;
+        return {"msg"=>N_("This accounting subject has [numerate,_1,an accounting record,accounting records].  It cannot be deleted.  To delete the subject, [numerate,_1,its accounting record,all of its accounting records] must first be deleted."),
+                "margs"=>[$CURRENT{"reccount"}],
+                "isform"=>0}
+            if $CURRENT{"reccount"} > 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::AcctSubj($status);
+        html_header $FORM->{"title"};
+        html_errmsg $status;
+        $FORM->html;
+        html_footer;
+    
+    # List the available items
+    } else {
+        if (list_type eq "lastlv") {
+            $LIST = new Selima::List::Accounting::Subjects::LastLv;
+        } else {
+            $LIST = new Selima::List::Accounting::Subjects;
+        }
+        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 accounting subject."),
+            "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 accounting subject 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 belonging subjects list
+    @_ = qw();
+    push @_, "sn AS sn";
+    if (@ALL_LINGUAS > 1) {
+        $title = $lang eq $DEFAULT_LANG? "title_$lndb":
+            "COALESCE(title_$lndb, title_$lndbdef)";
+    } else {;
+        $title = "title";
+    }
+    push @_, $DBH->strcat("code", "' '", $title) . " AS title";
+    $sql = "SELECT " . join(", ", @_) . " FROM acctsubj"
+        . " WHERE parent=$sn"
+        . " ORDER BY code;\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    $CURRENT{"ssubcount"} = $sth->rows;
+    for ($_ = 0; $_ < $CURRENT{"ssubcount"}; $_++) {
+        $row = $sth->fetchrow_hashref;
+        $CURRENT{"ssub$_" . "sn"} = $$row{"sn"};
+        $CURRENT{"ssub$_" . "title"} = $$row{"title"};
+    }
+    
+    # Obtain the belonging records list
+    $sql = "SELECT sn FROM acctrecs"
+        . " WHERE subj=$sn;\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    $CURRENT{"reccount"} = $sth->rows;
+    
+    # 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], "acctsubj") {
+        $FORM->param("parent", $GET->param("selsn"));
+        $FORM->param("topmost", "false");
+    }
+    return;
+}

htdocs/emandy/magicat/cgi-bin/accttrx.cgi

@@ -0,0 +1,278 @@
+#! /usr/bin/perl -w
+# Mandy Wu's Website
+# accttrx.cgi: The accounting transaction administraion.
+
+#  Copyright (c) 2007-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: 2007-09-24
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::emandy;
+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_selsubj($);
+
+initenv(-restricted => 1,
+        -this_table => "accttrx",
+        -dbi_lock   => {"accttrx"               => LOCK_EX,
+                        "acctrecs"              => LOCK_EX,
+                        "acctsubj"              => LOCK_SH},
+        -lastmod    => 1,
+        -page_param => {"keywords"              => N_("accounting"),
+                        "javascripts"   => [qw(/scripts/accounting.js)]});
+
+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::AcctTrx($POST);
+            $success = $processor->process;
+            success_redirect $success;
+        }
+    }
+    return;
+}
+
+# check_get: Check the GET arguments
+sub check_get() {
+    local ($_, %_);
+    my $error;
+    # Only allowing to run on HTTPS
+    http_403 if !is_https;
+    
+    # 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);
+    # Only allowing to run on HTTPS
+    http_403 if !is_https;
+    $_ = form_type;
+    # A form to create a new item
+    if ($_ eq "new") {
+        # Run the checker
+        $checker = new Selima::Checker::AcctTrx(curform);
+        $checker->redir(qw(cnvttrans selsubj));
+        $error = $checker->check(qw(date ord note recs));
+        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::AcctTrx(curform);
+        $checker->redir(qw(del cnvttrans selsubj));
+        $error = $checker->check(qw(date ord note recs));
+        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::AcctTrx(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::AcctTrx($status);
+        html_header $FORM->{"title"};
+        html_errmsg $status;
+        $FORM->html;
+        html_footer;
+    
+    # List the available items
+    } else {
+        $LIST = new Selima::List::Accounting::Transacts;
+        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 accounting transaction."),
+            "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 accounting transaction does not exist anymore.  Please select another one."),
+            "isform"=>0}
+        if scalar(keys %CURRENT) == 0;
+    
+    # Obtain the belonging debit records list
+    $sql = "SELECT * FROM acctrecs"
+        . " WHERE trx=$sn"
+        . " AND NOT credit"
+        . " ORDER BY ord;\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    $CURRENT{"debtcount"} = $sth->rows;
+    for ($_ = 0; $_ < $CURRENT{"debtcount"}; $_++) {
+        $row = $sth->fetchrow_hashref;
+        $CURRENT{"debt$_" . "sn"} = $$row{"sn"};
+        $CURRENT{"debt$_" . "ord"} = $$row{"ord"};
+        $CURRENT{"debt$_" . "subj"} = $$row{"subj"};
+        $CURRENT{"debt$_" . "summary"} = $$row{"summary"};
+        $CURRENT{"debt$_" . "amount"} = $$row{"amount"};
+    }
+    
+    # Obtain the belonging credit records list
+    $sql = "SELECT * FROM acctrecs"
+        . " WHERE trx=$sn"
+        . " AND credit"
+        . " ORDER BY ord;\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    $CURRENT{"crdtcount"} = $sth->rows;
+    for ($_ = 0; $_ < $CURRENT{"crdtcount"}; $_++) {
+        $row = $sth->fetchrow_hashref;
+        $CURRENT{"crdt$_" . "sn"} = $$row{"sn"};
+        $CURRENT{"crdt$_" . "ord"} = $$row{"ord"};
+        $CURRENT{"crdt$_" . "subj"} = $$row{"subj"};
+        $CURRENT{"crdt$_" . "summary"} = $$row{"summary"};
+        $CURRENT{"crdt$_" . "amount"} = $$row{"amount"};
+    }
+    
+    # Determine the subform type
+    if (        $CURRENT{"debtcount"} == 1
+                && acctsubj_code($CURRENT{"debt0subj"}) eq ACCTSUBJ_CASH
+                && !defined $CURRENT{"debt0summary"}) {
+        $CURRENT{"formsub"} = "income";
+    } elsif (   $CURRENT{"crdtcount"} == 1
+                && acctsubj_code($CURRENT{"crdt0subj"}) eq ACCTSUBJ_CASH
+                && !defined $CURRENT{"crdt0summary"}) {
+        $CURRENT{"formsub"} = "expense";
+    } else {
+        $CURRENT{"formsub"} = "trans";
+    }
+    
+    # OK
+    return;
+}
+
+# import_selsubj: Import the selected subject into the retrieved form
+sub import_selsubj($) {
+    my $FORM;
+    $FORM = $_[0];
+    # Sanity checks
+    return $FORM
+        if  !defined $GET->param("selsn")
+            || !check_sn_in ${$GET->param_fetch("selsn")}[0], "acctsubj"
+            || !defined $FORM->param("caller_index");
+    $FORM->param($FORM->param("caller_index") . "subj", $GET->param("selsn"));
+    return $FORM;
+}

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

@@ -0,0 +1,51 @@
+#! /usr/bin/perl -w
+# Mandy Wu's Website
+# actlog.cgi: The activity log viewer.
+
+#  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-11-14
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::emandy;
+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/emandy/magicat/cgi-bin/books.cgi

@@ -0,0 +1,226 @@
+#! /usr/bin/perl -w
+# Mandy Wu's Website
+# books.cgi: The book 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-11-15
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::emandy;
+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 => "books",
+        -dbi_lock   => {"books"                 => LOCK_EX},
+        -lastmod    => 1,
+        -page_param => {"keywords"              => N_("books")});
+
+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::emandy::Processor::Book($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") {
+            # Start from the default language
+            return {"msg"=>N_("Please create a new book from [_1]."),
+                    "margs"=>["_DEFAULT_LANG"],
+                    "isform"=>0}
+                if getlang ne $DEFAULT_LANG;
+        
+        # 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") {
+        # Start from the default language
+        return {"msg"=>N_("Please create a new book from [_1]."),
+                "margs"=>["_DEFAULT_LANG"],
+                "isform"=>0}
+            if getlang ne $DEFAULT_LANG;
+        # Run the checker
+        $checker = new Selima::emandy::Checker::Book(curform);
+        $error = $checker->check(qw(title author year origin pub
+            review comment lib));
+        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::emandy::Checker::Book(curform);
+        $checker->redir(qw(del));
+        $error = $checker->check(qw(title author year origin pub
+            review comment lib));
+        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::emandy::Checker::Book(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::emandy::Form::Book($status);
+        html_header $FORM->{"title"};
+        html_errmsg $status;
+        $FORM->html;
+        html_footer;
+    
+    # List the available items
+    } else {
+        if (list_type eq "toborrow") {
+            $LIST = new Selima::emandy::List::Books::ToBorrow;
+        } elsif (list_type eq "nottoborrow") {
+            $LIST = new Selima::emandy::List::Books::NotToBorrow;
+        } else {
+            $LIST = new Selima::emandy::List::Books;
+        }
+        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 book."),
+            "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 book does not exist anymore.  Please select another one."),
+            "isform"=>0}
+        if scalar(keys %CURRENT) == 0;
+    
+    # OK
+    return;
+}

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

@@ -0,0 +1,236 @@
+#! /usr/bin/perl -w
+# Mandy Wu's Website
+# groupmem.cgi: The group-to-group membership 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-11-14
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::emandy;
+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/emandy/magicat/cgi-bin/groups.cgi

@@ -0,0 +1,357 @@
+#! /usr/bin/perl -w
+# Mandy Wu's Website
+# groups.cgi: The account group 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-11-14
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::emandy;
+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/emandy/magicat/cgi-bin/legend.cgi

@@ -0,0 +1,218 @@
+#! /usr/bin/perl -w
+# Mandy Wu's Website
+# legend.cgi: The blog 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-11-15
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::emandy;
+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 => "legend",
+        -dbi_lock   => {"legend"                => LOCK_EX},
+        -lastmod    => 1,
+        -page_param => {"keywords"              => N_("legend")});
+
+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::emandy::Processor::Legend($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") {
+            # Start from the default language
+            return {"msg"=>N_("Please write a new legend entry from [_1]."),
+                    "margs"=>["_DEFAULT_LANG"],
+                    "isform"=>0}
+                if getlang ne $DEFAULT_LANG;
+        
+        # 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") {
+        # Start from the default language
+        return {"msg"=>N_("Please write a new legend entry from [_1]."),
+                "margs"=>["_DEFAULT_LANG"],
+                "isform"=>0}
+            if getlang ne $DEFAULT_LANG;
+        # Run the checker
+        $checker = new Selima::emandy::Checker::Legend(curform);
+        $error = $checker->check(qw(title body));
+        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::emandy::Checker::Legend(curform);
+        $checker->redir(qw(del));
+        $error = $checker->check(qw(title body));
+        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::emandy::Checker::Legend(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::emandy::Form::Legend($status);
+        html_header $FORM->{"title"};
+        html_errmsg $status;
+        $FORM->html;
+        html_footer;
+    
+    # List the available items
+    } else {
+        $LIST = new Selima::emandy::List::Legend;
+        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 legend entry."),
+            "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 legend entry does not exist anymore.  Please select another one."),
+            "isform"=>0}
+        if scalar(keys %CURRENT) == 0;
+    
+    # OK
+    return;
+}

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

@@ -0,0 +1,292 @@
+#! /usr/bin/perl -w
+# Mandy Wu's Website
+# linkcat.cgi: The related-link category 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-11-14
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::emandy;
+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/emandy/magicat/cgi-bin/linkcatz.cgi

@@ -0,0 +1,236 @@
+#! /usr/bin/perl -w
+# Mandy Wu's Website
+# linkcatz.cgi: The related-link category membership 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-11-14
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::emandy;
+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/emandy/magicat/cgi-bin/links.cgi

@@ -0,0 +1,240 @@
+#! /usr/bin/perl -w
+# Mandy Wu's Website
+# links.cgi: The related-link 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-11-14
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::emandy;
+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/emandy/magicat/cgi-bin/logout.cgi

@@ -0,0 +1,158 @@
+#! /usr/bin/perl -w
+# Mandy Wu's Website
+# logout.cgi: The log-out script.
+
+#  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-11-14
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::emandy;
+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/emandy/magicat/cgi-bin/material.cgi

@@ -0,0 +1,221 @@
+#! /usr/bin/perl -w
+# Mandy Wu's Website
+# material.cgi: The historical material 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-11-23
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::emandy;
+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 => "material",
+        -dbi_lock   => {"material"              => LOCK_EX,
+                        "mtrltype"              => LOCK_SH},
+        -lastmod    => 1,
+        -page_param => {"keywords"              => N_("materials")});
+
+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::emandy::Processor::Material($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") {
+            # Start from the default language
+            return {"msg"=>N_("Please create a new material from [_1]."),
+                    "margs"=>["_DEFAULT_LANG"],
+                    "isform"=>0}
+                if getlang ne $DEFAULT_LANG;
+        
+        # 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") {
+        # Start from the default language
+        return {"msg"=>N_("Please create a new material from [_1]."),
+                "margs"=>["_DEFAULT_LANG"],
+                "isform"=>0}
+            if getlang ne $DEFAULT_LANG;
+        # Run the checker
+        $checker = new Selima::emandy::Checker::Material(curform);
+        $error = $checker->check(qw(type year title body source
+            author notes));
+        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::emandy::Checker::Material(curform);
+        $checker->redir(qw(del));
+        $error = $checker->check(qw(type year title body source
+            author notes));
+        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::emandy::Checker::Material(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::emandy::Form::Material($status);
+        html_header $FORM->{"title"};
+        html_errmsg $status;
+        $FORM->html;
+        html_footer;
+    
+    # List the available items
+    } else {
+        $LIST = new Selima::emandy::List::Material;
+        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 material."),
+            "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 material does not exist anymore.  Please select another one."),
+            "isform"=>0}
+        if scalar(keys %CURRENT) == 0;
+    
+    # OK
+    return;
+}

htdocs/emandy/magicat/cgi-bin/mtrltype.cgi

@@ -0,0 +1,243 @@
+#! /usr/bin/perl -w
+# Mandy Wu's Website
+# mtrltype.cgi: The historical material type 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-11-23
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::emandy;
+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 => "mtrltype",
+        -dbi_lock   => {"mtrltype"              => LOCK_EX,
+                        "material"              => LOCK_SH},
+        -lastmod    => 1,
+        -page_param => {"keywords"              => N_("materials")});
+
+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::emandy::Processor::MtrlType($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") {
+            # Start from the default language
+            return {"msg"=>N_("Please create a new type from [_1]."),
+                    "margs"=>["_DEFAULT_LANG"],
+                    "isform"=>0}
+                if getlang ne $DEFAULT_LANG;
+        
+        # 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 type has [numerate,_1,a material,materials].  It cannot be deleted.  To delete the type, [numerate,_1,its material,all of its materials] must first be deleted."),
+                    "margs"=>[$CURRENT{"mtrlcount"}],
+                    "isform"=>0}
+                if $CURRENT{"mtrlcount"} > 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") {
+        # Start from the default language
+        return {"msg"=>N_("Please create a new type from [_1]."),
+                "margs"=>["_DEFAULT_LANG"],
+                "isform"=>0}
+            if getlang ne $DEFAULT_LANG;
+        # Run the checker
+        $checker = new Selima::emandy::Checker::MtrlType(curform);
+        $error = $checker->check(qw(ord 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::emandy::Checker::MtrlType(curform);
+        $checker->redir(qw(del));
+        $error = $checker->check(qw(ord 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::emandy::Checker::MtrlType(curform);
+        $checker->redir(qw(cancel));
+        return {"msg"=>N_("This type has [numerate,_1,a material,materials].  It cannot be deleted.  To delete the type, [numerate,_1,its material,all of its materials] must first be deleted."),
+                "margs"=>[$CURRENT{"mtrlcount"}],
+                "isform"=>0}
+            if $CURRENT{"mtrlcount"} > 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::emandy::Form::MtrlType($status);
+        html_header $FORM->{"title"};
+        html_errmsg $status;
+        $FORM->html;
+        html_footer;
+    
+    # List the available items
+    } else {
+        $LIST = new Selima::emandy::List::MtrlType;
+        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 type."),
+            "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 type does not exist anymore.  Please select another one."),
+            "isform"=>0}
+        if scalar(keys %CURRENT) == 0;
+    
+    # Obtain the belonging materials list
+    @_ = qw();
+    push @_, "sn AS sn";
+    push @_, "title AS title";
+    $sql = "SELECT " . join(", ", @_) . " FROM material"
+        . " WHERE type=$sn"
+        . " ORDER BY title;\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    $CURRENT{"mtrlcount"} = $sth->rows;
+    for ($_ = 0; $_ < $CURRENT{"mtrlcount"}; $_++) {
+        $row = $sth->fetchrow_hashref;
+        $CURRENT{"mtrl$_" . "sn"} = $$row{"sn"};
+        $CURRENT{"mtrl$_" . "title"} = $$row{"title"};
+    }
+    
+    # OK
+    return;
+}

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

@@ -0,0 +1,221 @@
+#! /usr/bin/perl -w
+# Mandy Wu's Website
+# 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-11-14
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::emandy;
+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/emandy/magicat/cgi-bin/rebuild.cgi

@@ -0,0 +1,105 @@
+#! /usr/bin/perl -w
+# Mandy Wu's Website
+# 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-11-14
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::emandy;
+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/emandy/magicat/cgi-bin/scptpriv.cgi

@@ -0,0 +1,223 @@
+#! /usr/bin/perl -w
+# Mandy Wu's Website
+# scptpriv.cgi: The script privilege 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-11-14
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::emandy;
+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/emandy/magicat/cgi-bin/test.cgi

@@ -0,0 +1,40 @@
+#! /usr/bin/perl -w
+# Mandy Wu's Website
+# test.cgi: The test script.
+
+#  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-11-14
+
+use 5.008;
+use utf8;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::emandy;
+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/emandy/magicat/cgi-bin/usermem.cgi

@@ -0,0 +1,236 @@
+#! /usr/bin/perl -w
+# Mandy Wu's Website
+# usermem.cgi: The user-to-group membership 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-11-14
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::emandy;
+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/emandy/magicat/cgi-bin/userpref.cgi

@@ -0,0 +1,225 @@
+#! /usr/bin/perl -w
+# Mandy Wu's Website
+# userpref.cgi: The user preference 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-11-14
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::emandy;
+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/emandy/magicat/cgi-bin/users.cgi

@@ -0,0 +1,273 @@
+#! /usr/bin/perl -w
+# Mandy Wu's Website
+# users.cgi: The user account 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-11-14
+
+use 5.008;
+use strict;
+use warnings;
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
+use Selima::emandy;
+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;
+}