Initial commit.

htdocs/emandy/magicat/lib/perl5/Selima/emandy.pm

@@ -0,0 +1,70 @@
+# Mandy Wu's Website
+# emandy.pm: Mandy Wu's Website.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-14
+
+package Selima::emandy;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Exporter);
+use vars qw(@EXPORT @EXPORT_OK);
+@EXPORT = qw();
+
+# Import our site-specific subroutines
+use Selima::emandy::Config;
+push @EXPORT, @Selima::emandy::Config::EXPORT;
+use Selima::emandy::DataVars qw(:all);
+push @EXPORT, @Selima::emandy::DataVars::EXPORT_OK;
+use Selima::emandy::HTML;
+push @EXPORT, @Selima::emandy::HTML::EXPORT;
+use Selima::emandy::Items;
+push @EXPORT, @Selima::emandy::Items::EXPORT;
+use Selima::emandy::Rebuild;
+push @EXPORT, @Selima::emandy::Rebuild::EXPORT;
+
+# Import our site-specific classess
+use Selima::emandy::Checker::Book;
+use Selima::emandy::Checker::Legend;
+use Selima::emandy::Checker::MtrlType;
+use Selima::emandy::Checker::Material;
+use Selima::emandy::Form::Book;
+use Selima::emandy::Form::Legend;
+use Selima::emandy::Form::MtrlType;
+use Selima::emandy::Form::Material;
+use Selima::emandy::L10N;
+use Selima::emandy::List::Books;
+use Selima::emandy::List::Books::NotToBorrow;
+use Selima::emandy::List::Books::ToBorrow;
+use Selima::emandy::List::Legend;
+use Selima::emandy::List::Legend::Public;
+use Selima::emandy::List::MtrlType;
+use Selima::emandy::List::Material;
+use Selima::emandy::List::Search;
+use Selima::emandy::Processor::Book;
+use Selima::emandy::Processor::Legend;
+use Selima::emandy::Processor::MtrlType;
+use Selima::emandy::Processor::Material;
+
+# Import our common modules
+use Selima;
+push @EXPORT, @Selima::EXPORT;
+
+@EXPORT_OK = @EXPORT;
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/Checker/Book.pm

@@ -0,0 +1,203 @@
+# Mandy Wu's Website
+# Book.pm: The book form checker.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-15
+
+package Selima::emandy::Checker::Book;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+use Selima::ShortCut;
+
+# new: Initialize the checker
+sub new : method {
+    local ($_, %_);
+    my ($class, $self);
+    ($class, @_) = @_;
+    $_[1] = "books" if scalar(@_) < 2 || !defined $_[1];
+    $self = $class->SUPER::new(@_);
+    ${$self->{"maxlens"}}{"year"} = 4;
+    return $self;
+}
+
+# _check_title: Check the title
+# Use the default title checker
+
+# _check_author: Check the author
+sub _check_author : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("author");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("author");
+    # Skip if it is not filled
+    return if $form->param("author") eq "";
+    # Check the length
+    return {"msg"=>N_("This author is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"author"}]}
+        if length $form->param("author") > ${$self->{"maxlens"}}{"author"};
+    # OK
+    return;
+}
+
+# _check_year: Check the year
+sub _check_year : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("year");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("year");
+    # Skip if it is not filled
+    return if $form->param("year") eq "";
+    # Check the length
+    return {"msg"=>N_("This year is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"year"}]}
+        if length $form->param("year") > ${$self->{"maxlens"}}{"year"};
+    # Check if it is a valid positive integer
+    return {"msg"=>N_("Please fill in a positive integer year.")}
+        unless $form->param("year") =~ /^\d+$/;
+    # Set to an integer
+    $_ = $form->param("year");
+    $_ += 0;
+    $form->param("year", $_);
+    # OK
+    return;
+}
+
+# _check_pub: Check the publisher
+sub _check_pub : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("pub");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("pub");
+    # Skip if it is not filled
+    return if $form->param("pub") eq "";
+    # Check the length
+    return {"msg"=>N_("This publisher is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"pub"}]}
+        if length $form->param("pub") > ${$self->{"maxlens"}}{"pub"};
+    # OK
+    return;
+}
+
+# _check_origin: Check the origin
+sub _check_origin : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("origin");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("origin");
+    # Skip if it is not filled
+    return if $form->param("origin") eq "";
+    # Check the length
+    return {"msg"=>N_("This origin is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"origin"}]}
+        if length $form->param("origin") > ${$self->{"maxlens"}}{"origin"};
+    # OK
+    return;
+}
+
+# _check_review: Check the review
+sub _check_review : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("review");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trimtext("review");
+    # Skip if it is not filled
+    $form->param("review", "")
+        if $form->param("review") eq __("Fill in the review here.");
+    return if $form->param("review") eq "";
+    # Check the length
+    return {"msg"=>N_("This review is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"review"}]}
+        if length $form->param("review") > ${$self->{"maxlens"}}{"review"};
+    # OK
+    return;
+}
+
+# _check_comment: Check the comment
+sub _check_comment : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("comment");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trimtext("comment");
+    # Skip if it is not filled
+    $form->param("comment", "")
+        if $form->param("comment") eq __("Fill in the comment here.");
+    return if $form->param("comment") eq "";
+    # Check the length
+    return {"msg"=>N_("This comment is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"comment"}]}
+        if length $form->param("comment") > ${$self->{"maxlens"}}{"comment"};
+    # OK
+    return;
+}
+
+# _check_lib: Check the libraries
+sub _check_lib : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("lib");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trimtext("lib");
+    # Skip if it is not filled
+    $form->param("lib", "")
+        if $form->param("lib") eq __("Fill in the libraries here.");
+    return if $form->param("lib") eq "";
+    # Check the length
+    return {"msg"=>N_("This libraries is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"lib"}]}
+        if length $form->param("lib") > ${$self->{"maxlens"}}{"lib"};
+    # OK
+    return;
+}
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/Checker/Legend.pm

@@ -0,0 +1,44 @@
+# Mandy Wu's Website
+# Legend.pm: The blog article form checker.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-15
+
+package Selima::emandy::Checker::Legend;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+# new: Initialize the checker
+sub new : method {
+    local ($_, %_);
+    my ($class, $self);
+    ($class, @_) = @_;
+    $_[1] = "legend" if scalar(@_) < 2 || !defined $_[1];
+    $self = $class->SUPER::new(@_);
+    ${$self->{"maxlens"}}{"body"} = 15360;
+    return $self;
+}
+
+# _check_title: Check the title
+# Use the default title checker
+
+# _check_body: Check the content
+# Use the default content checker
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/Checker/Material.pm

@@ -0,0 +1,160 @@
+# Mandy Wu's Website
+# Material.pm: The historical material form checker.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-23
+
+package Selima::emandy::Checker::Material;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+use Selima::ChkFunc;
+use Selima::ShortCut;
+
+# new: Initialize the checker
+sub new : method {
+    local ($_, %_);
+    my ($class, $self);
+    ($class, @_) = @_;
+    $_[1] = "material" if scalar(@_) < 2 || !defined $_[1];
+    $self = $class->SUPER::new(@_);
+    return $self;
+}
+
+# _check_type: Check the type
+sub _check_type : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("type");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("type");
+    # Skip if it is not filled
+    return if $form->param("type") eq "";
+    # Check if the type exists
+    return {"msg"=>N_("This type does not exist anymore.  Please select another one.")}
+        if !check_sn_in ${$form->param_fetch("type")}[0], "mtrltype";
+    # OK
+    return;
+}
+
+# _check_year: Check the year
+sub _check_year : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("year");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("year");
+    # Skip if it is not filled
+    return if $form->param("year") eq "";
+    # Check the length
+    return {"msg"=>N_("This year is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"year"}]}
+        if length $form->param("year") > ${$self->{"maxlens"}}{"year"};
+    # Check if it is a valid positive integer
+    return {"msg"=>N_("Please fill in a positive integer year.")}
+        unless $form->param("year") =~ /^\d+$/;
+    # Set to an integer
+    $_ = $form->param("year");
+    $_ += 0;
+    $form->param("year", $_);
+    # OK
+    return;
+}
+
+# _check_title: Check the title
+# Use the default title checker
+
+# _check_body: Check the content
+# Use the default content checker
+
+# _check_source: Check the source
+sub _check_source : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("source");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("source");
+    # Check if it is filled
+    return {"msg"=>N_("Please fill in the source.")}
+        if $form->param("source") eq "";
+    # Check the length
+    return {"msg"=>N_("This source is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"source"}]}
+        if length $form->param("source") > ${$self->{"maxlens"}}{"source"};
+    # OK
+    return;
+}
+
+# _check_author: Check the author
+sub _check_author : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("author");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trim("author");
+    # Skip if it is not filled
+    return if $form->param("author") eq "";
+    # Check the length
+    return {"msg"=>N_("This author is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"author"}]}
+        if length $form->param("author") > ${$self->{"maxlens"}}{"author"};
+    # OK
+    return;
+}
+
+# _check_notes: Check the notes
+sub _check_notes : method {
+    local ($_, %_);
+    my ($self, $form, $error);
+    $self = $_[0];
+    $form = $self->{"form"};
+    # Check if it exists
+    $error = $self->_missing("notes");
+    return $error if defined $error;
+    # Regularize it
+    $self->_trimtext("notes");
+    # Skip if it is not filled
+    $form->param("notes", "")
+        if $form->param("notes") eq __("Fill in the notes here.");
+    return if $form->param("notes") eq "";
+    # Check the length
+    return {"msg"=>N_("This notes is too long.  (Max. length [#,_1])"),
+            "margs"=>[${$self->{"maxlens"}}{"notes"}]}
+        if length $form->param("notes") > ${$self->{"maxlens"}}{"notes"};
+    # OK
+    return;
+}
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/Checker/MtrlType.pm

@@ -0,0 +1,46 @@
+# Mandy Wu's Website
+# MtrlType.pm: The historical material type form checker.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-23
+
+package Selima::emandy::Checker::MtrlType;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Checker);
+
+use Selima::ShortCut;
+
+# new: Initialize the checker
+sub new : method {
+    local ($_, %_);
+    my ($class, $self);
+    ($class, @_) = @_;
+    $_[1] = "mtrltype" if scalar(@_) < 2 || !defined $_[1];
+    $self = $class->SUPER::new(@_);
+    ${$self->{"maxlens"}}{"ord"} = 2;
+    return $self;
+}
+
+# _check_ord: Check the order
+# Use the default order checker
+
+# _check_title: Check the title
+# Use the default title checker
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/Config.pm

@@ -0,0 +1,92 @@
+# Mandy Wu's Website
+# Config.pm: The web site configuration.
+
+#  Copyright (c) 2006-2020 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
+
+package Selima::emandy::Config;
+use 5.008;
+use utf8;
+use strict;
+use warnings;
+use base qw(Exporter);
+use vars qw(@EXPORT @EXPORT_OK);
+BEGIN {
+@EXPORT = qw(siteconf page_replacements);
+@EXPORT_OK = @EXPORT;
+# Prototype declaration
+sub siteconf();
+sub page_replacements();
+}
+
+# Get into the public variable space and initialize them
+use lib $ENV{"DOCUMENT_ROOT"} . qw(/../../lib/perl5);
+use Selima::CopyYear;
+use Selima::DataVars qw(:all);
+use Selima::ShortCut;
+
+use Selima::emandy::DataVars qw(:all);
+
+# siteconf: Subroutine to initialize site configuration
+sub siteconf() {
+    local ($_, %_);
+    
+    # The package name and the package title
+    $PACKAGE = "emandy";
+    $SITENAME_ABBR = "eMandy";
+    # The author and the copyright
+    $AUTHOR = "小招";
+    $COPYRIGHT = "&copy; <!--selima:copyyear--> 小招。小招保有所有權利。";
+    # Document root, the library and the l10n directories
+    $DOC_ROOT = $ENV{"DOCUMENT_ROOT"};
+    $SITE_LIBDIR = $DOC_ROOT . "/magicat/lib/perl5";
+    $LOCALEDIR = $DOC_ROOT . "/magicat/locale";
+    
+    # Tables to lock when rebuilding pages
+    @REBUILD_TABLES = qw(linkcat links linkcatz legend);
+    # The local rebuild type labels
+    %REBUILD_LABELS = (
+        "legend"    => N_("Legend"),
+    );
+    
+    # The languages
+    $DEFAULT_LANG = "zh-tw";
+    @ALL_LINGUAS = qw(zh-tw);
+    
+    # The site data variables
+
+    
+    return;
+}
+
+# page_replacements: Dynamic page elements to be replaced,
+#   but not part of the content.  Used by xfupdate_template().
+sub page_replacements() {
+    return {
+        "copyyear"  => {
+            "pattern"   => "2006(?:-\\d{4})?",
+            "content"   => copyyear(2006),
+        },
+        "generator" => {
+            "pattern"   => "Selima \\d+\\.\\d+",
+            "content"   => "Selima $Selima::VERSION",
+        },
+    };
+}
+
+no utf8;
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/DataVars.pm

@@ -0,0 +1,53 @@
+# Mandy Wu's Website
+# DataVars.pm: The site-wide constants and variables.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-14
+
+package Selima::emandy::DataVars;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Exporter);
+use vars qw(@EXPORT %EXPORT_TAGS @EXPORT_OK);
+BEGIN {
+@EXPORT = qw();
+%EXPORT_TAGS = (
+    forms   => [qw()],
+);
+@EXPORT_OK = qw();
+my %seen;
+%seen = qw();
+foreach my $tag (keys %EXPORT_TAGS) {
+    push @EXPORT_OK, grep !$seen{$_}++, @{$EXPORT_TAGS{$tag}};
+}
+$EXPORT_TAGS{"all"} = [@EXPORT_OK];
+# Prototype declaration
+sub clear();
+}
+
+use Selima::DataVars qw(:forms);
+
+# clear: Clear the data variables
+sub clear() {
+    local ($_, %_);
+    
+    
+    return;
+}
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/Form/Book.pm

@@ -0,0 +1,129 @@
+# Mandy Wu's Website
+# Book.pm: The book form.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-15
+
+package Selima::emandy::Form::Book;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Form);
+
+use Selima::FormFunc;
+use Selima::HTTP;
+use Selima::MarkAbbr;
+use Selima::ShortCut;
+
+# new: Initialize the HTML form table displayer
+sub new : method {
+    local ($_, %_);
+    my ($class, $status, $args, $self);
+    ($class, $status, $args) = @_;
+    $args = {} if !defined $args;
+    
+    # $args must be a hash reference
+    http_500 "type of argument 2 must be a hash reference"
+        if ref($args) ne "HASH";
+    $$args{"type"} = form_type
+        if !exists $$args{"type"};
+    $$args{"table"} = "books"
+        if !exists $$args{"table"};
+    $$args{"deltext"} = __("Delete this book")
+        if !exists $$args{"deltext"};
+    if (!exists $$args{"summary"}) {
+        # A form to create a new item
+        if ($$args{"type"} eq "new") {
+            $$args{"summary"} = __("This table provides you a form to add a new book.");
+        # A form to edit a current item
+        } elsif ($$args{"type"} eq "cur") {
+            $$args{"summary"} = __("This table provides you a form to edit a current book.");
+        # A form to delete a current item
+        } elsif ($$args{"type"} eq "del") {
+            $$args{"summary"} = __("This table provides you a form to delete a book.");
+        }
+    }
+    if (!exists $$args{"cols"}) {
+        # A form to create a new item
+        if ($$args{"type"} eq "new") {
+            $$args{"cols"} = [qw(title author year origin pub
+                toborrow review comment lib)];
+        # A form to edit a current item
+        # A form to delete a current item
+        } elsif ($$args{"type"} eq "cur" || $$args{"type"} eq "del") {
+            $$args{"cols"} = [qw(sn title author year origin pub
+                toborrow review comment lib)];
+        }
+    }
+    if (!exists $$args{"title"}) {
+        # A form to create a new item
+        if ($$args{"type"} eq "new") {
+            $$args{"title"} = __("Add a New Book");
+        # A form to edit a current item
+        } elsif ($$args{"type"} eq "cur") {
+            $$args{"title"} = __("Edit a Current Book");
+        # A form to delete a current item
+        } elsif ($$args{"type"} eq "del") {
+            $$args{"title"} = __("Delete a Book");
+        }
+    }
+    $self = $class->SUPER::new($status, $args);
+    ${$self->{"maxlens"}}{"year"} = 4;
+    return $self;
+}
+
+# _html_col_year: The year
+sub _html_col_year : method {
+    $_[0]->_html_coltmpl_text("year", h_abbr(__("Year:")), undef, 4);
+}
+
+# _html_col_pub: The publisher
+sub _html_col_pub : method {
+    $_[0]->_html_coltmpl_text("pub", h_abbr(__("Publisher:")));
+}
+
+# _html_col_toborrow: To borrow?
+sub _html_col_toborrow : method {
+    $_[0]->_html_coltmpl_bool("toborrow", h_abbr(__("To be borrowed?")),
+        h_abbr(__("To be borrowed")), h_abbr(__("Not to be borrowed")),
+        h_abbr(__("This book is to be borrowed.")));
+}
+
+# _html_col_origin: The origin
+sub _html_col_origin : method {
+    $_[0]->_html_coltmpl_text("origin", h_abbr(__("Origin:")));
+}
+
+# _html_col_review: The review
+sub _html_col_review : method {
+    $_[0]->_html_coltmpl_textarea("review", h_abbr(__("Review:")),
+        h_abbr(__("Fill in the review here.")), undef, 5);
+}
+
+# _html_col_comment: The comment
+sub _html_col_comment : method {
+    $_[0]->_html_coltmpl_textarea("comment", h_abbr(__("Comment:")),
+        h_abbr(__("Fill in the comment here.")), undef, 5);
+}
+
+# _html_col_lib: The libraries
+sub _html_col_lib : method {
+    $_[0]->_html_coltmpl_textarea("lib", h_abbr(__("Libraries:")),
+        h_abbr(__("Fill in the libraries here.")), undef, 5);
+}
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/Form/Legend.pm

@@ -0,0 +1,99 @@
+# Mandy Wu's Website
+# Legend.pm: The blog article form.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-15
+
+package Selima::emandy::Form::Legend;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Form);
+
+use Selima::FormFunc;
+use Selima::HTTP;
+use Selima::MarkAbbr;
+use Selima::ShortCut;
+
+# new: Initialize the HTML form table displayer
+sub new : method {
+    local ($_, %_);
+    my ($class, $status, $args, $self);
+    ($class, $status, $args) = @_;
+    $args = {} if !defined $args;
+    
+    # $args must be a hash reference
+    http_500 "type of argument 2 must be a hash reference"
+        if ref($args) ne "HASH";
+    $$args{"type"} = form_type
+        if !exists $$args{"type"};
+    $$args{"table"} = "legend"
+        if !exists $$args{"table"};
+    $$args{"deltext"} = __("Delete this legend entry")
+        if !exists $$args{"deltext"};
+    if (!exists $$args{"summary"}) {
+        # A form to create a new item
+        if ($$args{"type"} eq "new") {
+            $$args{"summary"} = __("This table provides you a form to write a new legend entry.");
+        # A form to edit a current item
+        } elsif ($$args{"type"} eq "cur") {
+            $$args{"summary"} = __("This table provides you a form to edit a current legend entry.");
+        # A form to delete a current item
+        } elsif ($$args{"type"} eq "del") {
+            $$args{"summary"} = __("This table provides you a form to delete a legend entry.");
+        }
+    }
+    if (!exists $$args{"cols"}) {
+        # A form to create a new item
+        if ($$args{"type"} eq "new") {
+            $$args{"cols"} = [qw(title body html hid)];
+        # A form to edit a current item
+        # A form to delete a current item
+        } elsif ($$args{"type"} eq "cur" || $$args{"type"} eq "del") {
+            $$args{"cols"} = [qw(sn title body html hid pageno
+                created createdby updated updatedby)];
+        }
+    }
+    if (!exists $$args{"title"}) {
+        # A form to create a new item
+        if ($$args{"type"} eq "new") {
+            $$args{"title"} = __("Write a New Legend Entry");
+        # A form to edit a current item
+        } elsif ($$args{"type"} eq "cur") {
+            $$args{"title"} = __("Edit a Current Legend Entry");
+        # A form to delete a current item
+        } elsif ($$args{"type"} eq "del") {
+            $$args{"title"} = __("Delete a Legend Entry");
+        }
+    }
+    $self = $class->SUPER::new($status, $args);
+    return $self;
+}
+
+# _html_col_hid: Hide?
+sub _html_col_hid : method {
+    $_[0]->_html_coltmpl_bool("hid", h_abbr(__("Hide?")),
+        h_abbr(__("Hide this legend entry")), h_abbr(__("Show this legend entry")),
+        h_abbr(__("Hide this legend entry currently.")));
+}
+
+# _html_col_pageno: The page number
+sub _html_col_pageno : method {
+    $_[0]->_html_coltmpl_ro("pageno", h_abbr(__("Page No.:")));
+}
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/Form/Material.pm

@@ -0,0 +1,112 @@
+# Mandy Wu's Website
+# Material.pm: The historical material form.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-23
+
+package Selima::emandy::Form::Material;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Form);
+
+use Selima::FormFunc;
+use Selima::HTTP;
+use Selima::MarkAbbr;
+use Selima::ShortCut;
+
+use Selima::emandy::Items;
+
+# new: Initialize the HTML form table displayer
+sub new : method {
+    local ($_, %_);
+    my ($class, $status, $args, $self);
+    ($class, $status, $args) = @_;
+    $args = {} if !defined $args;
+    
+    # $args must be a hash reference
+    http_500 "type of argument 2 must be a hash reference"
+        if ref($args) ne "HASH";
+    $$args{"type"} = form_type
+        if !exists $$args{"type"};
+    $$args{"table"} = "material"
+        if !exists $$args{"table"};
+    $$args{"deltext"} = __("Delete this material")
+        if !exists $$args{"deltext"};
+    if (!exists $$args{"summary"}) {
+        # A form to create a new item
+        if ($$args{"type"} eq "new") {
+            $$args{"summary"} = __("This table provides you a form to add a new material.");
+        # A form to edit a current item
+        } elsif ($$args{"type"} eq "cur") {
+            $$args{"summary"} = __("This table provides you a form to edit a current material.");
+        # A form to delete a current item
+        } elsif ($$args{"type"} eq "del") {
+            $$args{"summary"} = __("This table provides you a form to delete a material.");
+        }
+    }
+    if (!exists $$args{"cols"}) {
+        # A form to create a new item
+        if ($$args{"type"} eq "new") {
+            $$args{"cols"} = [qw(type year title body source
+                author notes)];
+        # A form to edit a current item
+        # A form to delete a current item
+        } elsif ($$args{"type"} eq "cur" || $$args{"type"} eq "del") {
+            $$args{"cols"} = [qw(sn type year title body source
+                author notes)];
+        }
+    }
+    if (!exists $$args{"title"}) {
+        # A form to create a new item
+        if ($$args{"type"} eq "new") {
+            $$args{"title"} = __("Add a New Material");
+        # A form to edit a current item
+        } elsif ($$args{"type"} eq "cur") {
+            $$args{"title"} = __("Edit a Current Material");
+        # A form to delete a current item
+        } elsif ($$args{"type"} eq "del") {
+            $$args{"title"} = __("Delete a Material");
+        }
+    }
+    $self = $class->SUPER::new($status, $args);
+    return $self;
+}
+
+# _html_col_type: The type
+sub _html_col_type : method {
+    $_[0]->_html_coltmpl_select("type",
+        h_abbr(__("Type:")), \&mtrltype_options, \&mtrltype_title);
+}
+
+# _html_col_year: The year
+sub _html_col_year : method {
+    $_[0]->_html_coltmpl_text("year", h_abbr(__("Year:")), undef, 4);
+}
+
+# _html_col_source: The source
+sub _html_col_source : method {
+    $_[0]->_html_coltmpl_text("source", h_abbr(__("Source:")));
+}
+
+# _html_col_notes: The notes
+sub _html_col_notes : method {
+    $_[0]->_html_coltmpl_textarea("notes", h_abbr(__("Notes:")),
+        h_abbr(__("Fill in the notes here.")), undef, 3);
+}
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/Form/MtrlType.pm

@@ -0,0 +1,93 @@
+# Mandy Wu's Website
+# MtrlType.pm: The historical material type form.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-23
+
+package Selima::emandy::Form::MtrlType;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Form);
+
+use Selima::FormFunc;
+use Selima::HTTP;
+use Selima::MarkAbbr;
+use Selima::ShortCut;
+
+# new: Initialize the HTML form table displayer
+sub new : method {
+    local ($_, %_);
+    my ($class, $status, $args, $self);
+    ($class, $status, $args) = @_;
+    $args = {} if !defined $args;
+    
+    # $args must be a hash reference
+    http_500 "type of argument 2 must be a hash reference"
+        if ref($args) ne "HASH";
+    $$args{"type"} = form_type
+        if !exists $$args{"type"};
+    $$args{"table"} = "mtrltype"
+        if !exists $$args{"table"};
+    $$args{"deltext"} = __("Delete this type")
+        if !exists $$args{"deltext"};
+    if (!exists $$args{"summary"}) {
+        # A form to create a new item
+        if ($$args{"type"} eq "new") {
+            $$args{"summary"} = __("This table provides you a form to add a new type.");
+        # A form to edit a current item
+        } elsif ($$args{"type"} eq "cur") {
+            $$args{"summary"} = __("This table provides you a form to edit a current type.");
+        # A form to delete a current item
+        } elsif ($$args{"type"} eq "del") {
+            $$args{"summary"} = __("This table provides you a form to delete a type.");
+        }
+    }
+    if (!exists $$args{"cols"}) {
+        # A form to create a new item
+        if ($$args{"type"} eq "new") {
+            $$args{"cols"} = [qw(ord title)];
+        # A form to edit a current item
+        # A form to delete a current item
+        } elsif ($$args{"type"} eq "cur" || $$args{"type"} eq "del") {
+            $$args{"cols"} = [qw(sn ord title)];
+        }
+    }
+    if (!exists $$args{"title"}) {
+        # A form to create a new item
+        if ($$args{"type"} eq "new") {
+            $$args{"title"} = __("Add a New Material Type");
+        # A form to edit a current item
+        } elsif ($$args{"type"} eq "cur") {
+            $$args{"title"} = __("Edit a Current Material Type");
+        # A form to delete a current item
+        } elsif ($$args{"type"} eq "del") {
+            $$args{"title"} = __("Delete a Material Type");
+        }
+    }
+    $self = $class->SUPER::new($status, $args);
+    ${$self->{"maxlens"}}{"ord"} = 2;
+    if ($self->{"type"} eq "cur") {
+        if (defined $self->{"cur"}->param("mtrlcount") && $self->{"cur"}->param("mtrlcount") > 0) {
+            $self->{"nodelete"} = 1;
+            push @{$self->{"prefmsg"}}, __("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.", $self->{"cur"}->param("mtrlcount"));
+        }
+    }
+    return $self;
+}
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/HTML.pm

@@ -0,0 +1,752 @@
+# Mandy Wu's Website
+# HTML.pm: The HTML web page parts.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-14
+
+package Selima::emandy::HTML;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Exporter);
+use vars qw(@EXPORT @EXPORT_OK);
+BEGIN {
+@EXPORT = qw();
+push @EXPORT, qw(html_header html_title html_message);
+push @EXPORT, qw(html_errmsg html_body html_links html_links_index);
+push @EXPORT, qw(html_legend_index);
+push @EXPORT, qw(html_footer);
+@EXPORT_OK = @EXPORT;
+# Prototype declaration
+sub html_header($;$);
+sub html_title($;$);
+sub html_message($);
+sub html_errmsg($);
+sub html_nav(;$);
+sub html_login(;$);
+sub html_nav_admin(;$);
+sub html_nav_page(;$);
+sub html_body($;$);
+sub html_links($;$);
+sub html_links_index(\@;$);
+sub html_legend_index(\@;$);
+sub html_footer(;$);
+sub merged_tree($$;$);
+}
+
+use Cwd qw(realpath);
+use File::Basename qw(dirname);
+use File::Spec::Functions qw();
+use IO::NestedCapture qw(CAPTURE_STDOUT);
+use Lingua::ZH::Numbers;
+
+use Selima::A2HTML;
+use Selima::AddGet;
+use Selima::AltLang;
+use Selima::DataVars qw(:author :env :input :list :lninfo :requri :siteconf);
+use Selima::ErrMsg;
+use Selima::Format;
+use Selima::HTTPS;
+use Selima::Links;
+use Selima::LnInfo;
+use Selima::LogIn;
+use Selima::MarkAbbr;
+use Selima::MungAddr;
+use Selima::PageFunc;
+use Selima::Preview;
+use Selima::ScptPriv;
+use Selima::ShortCut;
+use Selima::Unicode;
+use Selima::XFileIO;
+
+use vars qw(@ADMIN_SCRIPTS %HEADER %FOOTER);
+@ADMIN_SCRIPTS = (
+    {   "title" => N_("Manage Content"),
+        "sub"   => [
+        {   "title"     => N_("Legend"),
+            "path"      => "/magicat/cgi-bin/legend.cgi" },
+        {   "title"     => N_("Books"),
+            "path"      => "/magicat/cgi-bin/books.cgi" },
+        {   "title"     => N_("Materials"),
+            "path"      => "/magicat/cgi-bin/material.cgi" },
+        {   "title"     => N_("Material Types"),
+            "path"      => "/magicat/cgi-bin/mtrltype.cgi" },
+        {   "title"     => N_("Pages"),
+            "path"      => "/magicat/cgi-bin/pages.cgi" },
+        {   "title"     => N_("Links"),
+            "path"      => "/magicat/cgi-bin/links.cgi" },
+        {   "title"     => N_("Link Categories"),
+            "path"      => "/magicat/cgi-bin/linkcat.cgi" },
+        {   "title"     => N_("Link Categorization"),
+            "path"      => "/magicat/cgi-bin/linkcatz.cgi" },
+        ],
+    },
+    {   "title" => N_("Manage Accounts"),
+        "sub"   => [
+        {   "title"     => N_("Users"),
+            "path"      => "/magicat/cgi-bin/users.cgi" },
+        {   "title"     => N_("Groups"),
+            "path"      => "/magicat/cgi-bin/groups.cgi" },
+        {   "title"     => N_("User Membership"),
+            "path"      => "/magicat/cgi-bin/usermem.cgi" },
+        {   "title"     => N_("Group Membership"),
+            "path"      => "/magicat/cgi-bin/groupmem.cgi" },
+        {   "title"     => N_("User Preferences"),
+            "path"      => "/magicat/cgi-bin/userpref.cgi" },
+        {   "title"     => N_("Script Privileges"),
+            "path"      => "/magicat/cgi-bin/scptpriv.cgi" },
+        ],
+    },
+    {   "title" => N_("Manage Accounting"),
+        "sub"   => [
+        {   "title"     => N_("Reports"),
+            "path"      => "/magicat/cgi-bin/acctreps.cgi",
+            "https"     => 1 },
+        {   "title"     => N_("Transactions"),
+            "path"      => "/magicat/cgi-bin/accttrx.cgi",
+            "https"     => 1 },
+        {   "title"     => N_("Subjects"),
+            "path"      => "/magicat/cgi-bin/acctsubj.cgi",
+            "https"     => 1 },
+        {   "title"     => N_("Records"),
+            "path"      => "/magicat/cgi-bin/acctrecs.cgi",
+            "https"     => 1 },
+        ],
+    },
+    {   "title" => N_("Miscellaneous"),
+    "sub"   => [
+        {   "title"     => N_("Activity Log"),
+            "path"      => "/magicat/cgi-bin/actlog.cgi" },
+        {   "title"     => N_("Rebuild Pages"),
+            "path"      => "/magicat/cgi-bin/rebuild.cgi" },
+        {   "title"     => N_("Analog"),
+            "path"      => "/magicat/analog/" },
+        {   "title"     => N_("Test Script"),
+            "path"      => "/magicat/cgi-bin/test.cgi" },
+        ],
+    },
+);
+
+# html_header: Display the page header
+sub html_header($;$) {
+    local ($_, %_);
+    my ($title, $args, $guide);
+    my ($langname, $langfile);
+    my ($author, $copyright, $keywords, $copypage);
+    my ($stylesheets, $javascripts, $favicon, $class, $onload);
+    my ($titlelang, $skiptobody);
+    ($title, $args) = @_;
+    # Obtain the page parameters
+    $args = page_param $args;
+    # Set the language
+    $langname = h(ln $$args{"lang"}, LN_NAME);
+    $langfile = ln($$args{"lang"}, LN_FILENAME);
+    # Misc
+    # The copyright message should be already HTML-escaped,
+    #   for the copyright sign "&copy;".
+    $author = exists $$args{"author"}? h($$args{"author"}):
+        defined $AUTHOR? h($AUTHOR): undef;
+    $copyright = exists $$args{"copyright"}? $$args{"copyright"}:
+        defined $COPYRIGHT? $COPYRIGHT: undef;
+    $keywords = exists $$args{"keywords"}? h($$args{"keywords"}): undef;
+    $copypage = exists $$args{"copypage"}? h($$args{"copypage"}): undef;
+    # Style sheets
+    $stylesheets = [];
+    push @$stylesheets, "/stylesheets/common.css";
+    push @$stylesheets, @{$$args{"stylesheets"}}
+        if exists $$args{"stylesheets"};
+    # JavaScripts
+    $javascripts = [];
+    if (exists $$args{"javascripts"}) {
+        push @$javascripts, "/scripts/common.js";
+        push @$javascripts, "/scripts/lang.$langfile.js";
+        push @$javascripts, @{$$args{"javascripts"}};
+    }
+    # Favorite icon
+    $favicon = exists $$args{"favicon"}?
+        h($$args{"favicon"}): h("/favicon.ico");
+    # The class of body
+    $class = exists $$args{"class"}?
+        " class=\"" . h($$args{"class"}) . "\"": "";
+    # The onload JavaScript event handler
+    $onload = exists $$args{"onload"}?
+        " onload=\"" . h($$args{"onload"}) . "\"": "";
+    # The accessibility guide
+    $skiptobody = h(__("Skip to the page content area."));
+    $guide = h(__("Page Content Area"));
+    
+    print << "EOT";
+<?xml version="1.0" encoding="<!--selima:charset-->" ?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
+    "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="$langname">
+<head>
+<meta http-equiv="Content-Type" content="application/xhtml+xml; charset=<!--selima:charset-->" />
+<meta http-equiv="Content-Style-Type" content="text/css" />
+<meta http-equiv="Content-Script-Type" content="text/javascript" />
+EOT
+    # Author, copyright and keywords
+    print "<meta name=\"author\" content=\"$author\" />\n"
+        if defined $author;
+    print "<meta name=\"copyright\" content=\"$copyright\" />\n"
+        if defined $copyright;
+    print "<meta name=\"keywords\" content=\"$keywords\" />\n"
+        if defined $keywords;
+    print "<meta name=\"generator\" content=\"<!--selima:generator-->\" />\n"
+        if $$args{"static"};
+    # The home page
+    print "<link rel=\"start\" type=\"application/xhtml+xml\" href=\"/\" />\n";
+    # The copyright page
+    print "<link rel=\"copyright\" type=\"application/xhtml+xml\""
+            . " href=\"$copypage\" />\n"
+        if defined $copypage;
+    # The author contact information
+    print "<link rel=\"author\" href=\"mailto:mandy\@mail.emandy.idv.tw\" />\n";
+    # Revelent pages
+    print "<link rel=\"up\" type=\"application/xhtml+xml\""
+            . " href=\"" . h($$args{"up"}) . "\" />\n"
+        if exists $$args{"up"};
+    print "<link rel=\"first\" type=\"application/xhtml+xml\""
+            . " href=\"" . h($$args{"first"}) . "\" />\n"
+        if exists $$args{"first"};
+    print "<link rel=\"prev\" type=\"application/xhtml+xml\""
+            . " href=\"" . h($$args{"prev"}) . "\" />\n"
+        if exists $$args{"prev"};
+    print "<link rel=\"next\" type=\"application/xhtml+xml\""
+            . " href=\"" . h($$args{"next"}) . "\" />\n"
+        if exists $$args{"next"};
+    print "<link rel=\"last\" type=\"application/xhtml+xml\""
+            . " href=\"" . h($$args{"last"}) . "\" />\n"
+        if exists $$args{"last"};
+    print "<link rel=\"contents\" type=\"application/xhtml+xml\""
+            . " href=\"" . h($$args{"toc"}) . "\" />\n"
+        if exists $$args{"toc"};
+    # Style sheets
+    print "<link rel=\"stylesheet\" type=\"text/css\""
+            . " href=\"" . h($_) . "\" />\n"
+        foreach @$stylesheets;
+    # JavaScripts
+    print "<script type=\"text/javascript\" src=\""
+            . h($_) . "\"></script>\n"
+        foreach @$javascripts;
+    # Favorite Icon
+    print "<link rel=\"shortcut icon\" type=\"image/x-icon\""
+        . " href=\"$favicon\" />\n";
+    # The title
+    $titlelang = $$args{"title_lang"} eq $$args{"lang"}? "":
+        " xml:lang=\"" . h(ln $$args{"title_lang"}, LN_NAME) . "\"";
+    print "<title" . $titlelang . ">" . h($title) . "</title>\n";
+    print << "EOT";
+</head>
+<body$class$onload>
+
+<div id="topofpage" class="skiptobody">
+<a accesskey="2" href="#body">$skiptobody</a>
+</div>
+
+
+EOT
+    
+    # Show the navigation area
+    html_nav $args;
+    # Embrace the content
+    print << "EOT";
+<div id="body" class="body" title="$guide">
+<div class="accessguide"><a accesskey="C"
+    href="#body" title="$guide">:::</a></div>
+
+EOT
+    # Display the title
+    html_title $title, $args unless $$args{"no_auto_title"};
+    
+    return;
+}
+
+# html_title: Print an HTML title
+sub html_title($;$) {
+    local ($_, %_);
+    my ($title, $args, $h);
+    ($title, $args) = @_;
+    $h = << "EOT";
+<h1>%s</h1>
+
+EOT
+    printf $h, h_abbr($title);
+    return;
+}
+
+# html_message: Print an HTML message
+sub html_message($) {
+    local ($_, %_);
+    $_ = $_[0];
+    return if !defined $_ || $_ eq "";
+    $_ = h_abbr($_);
+    print << "EOT";
+<p class="message">$_</p>
+
+EOT
+    return;
+}
+
+# html_errmsg: Print an HTML error message, a wrapper to html_message()
+sub html_errmsg($) {
+    local ($_, %_);
+    $_ = $_[0];
+    return if !defined $_;
+    html_message(err2msg $_);
+    return;
+}
+
+# html_nav: Print the HTML navigation bar
+sub html_nav(;$) {
+    local ($_, %_);
+    my ($args, $lang, $guide, $FD, @sections);
+    $args = $_[0];
+    # Obtain the page parameters
+    $args = page_param $args;
+    $lang = $$args{"lang"};
+    # The accessibility guide
+    $guide = h(__("Navigation Links Area"));
+    
+    @sections = qw();
+    # Print the primary navigation bar
+    $HEADER{"file"} = sprintf("%s/magicat/include/header.html", $DOC_ROOT)
+        if !exists $HEADER{"file"};
+    undef $_;
+    if (    !exists $HEADER{"content"}
+            || !exists $HEADER{"date"}
+            || $HEADER{"date"} < ($_ = (stat $HEADER{"file"})[9])) {
+        $_ = (stat $HEADER{"file"})[9] if !defined $_;
+        $HEADER{"date"} = $_;
+        $HEADER{"content"} = hcref_decode ln($lang, LN_CHARSET), xfread $HEADER{"file"};
+    }
+    push @sections, $HEADER{"content"};
+    
+    # Print the section-specific navigation links
+    push @sections, $$args{"header_html_nav"}
+        if exists $$args{"header_html_nav"};
+    
+    # Print the log-in information
+    IO::NestedCapture->start(CAPTURE_STDOUT);
+    binmode IO::NestedCapture->instance->{"STDOUT_current"}[-1], ":utf8";
+    html_login $args;
+    IO::NestedCapture->stop(CAPTURE_STDOUT);
+    $FD = IO::NestedCapture->get_last_out;
+    $_ = join "", <$FD>;
+    push @sections, $_ if $_ ne "";
+    
+    # Print the section-specific navigation bar
+    IO::NestedCapture->start(CAPTURE_STDOUT);
+    binmode IO::NestedCapture->instance->{"STDOUT_current"}[-1], ":utf8";
+    if ($$args{"admin"}) {
+        html_nav_admin $args;
+    } else {
+        html_nav_page $args;
+    }
+    IO::NestedCapture->stop(CAPTURE_STDOUT);
+    $FD = IO::NestedCapture->get_last_out;
+    $_ = join "", <$FD>;
+    push @sections, $_ if $_ ne "";
+    
+    # Embrace the navigation links
+    print << "EOT";
+<div id="nav" class="nav" title="$guide">
+<div class="accessguide"><a accesskey="L"
+    href="#nav" title="$guide">:::</a></div>
+
+EOT
+    # Print each navigation sections
+    print join "<hr />\n\n", @sections;
+    # Embrace the navigation links
+    print << "EOT";
+</div>
+<hr />
+
+EOT
+    
+    return;
+}
+
+# html_login: Print the HTML log-in information
+sub html_login(;$) {
+    local ($_, %_);
+    my ($args, $msg, $modify, $submit);
+    $args = $_[0];
+    # Skip if not logged-in
+    return if !defined get_login_sn;
+    # Obtain the page parameters
+    $args = page_param $args;
+    # No log-in bar for static pages
+    return if $$args{"static"};
+    
+    # The message
+    $modify = "/magicat/cgi-bin/users.cgi?form=cur&sn=" . get_login_sn;
+    $msg = sprintf __("Welcome, %s. (<span><a href=\"%s\">Modify</a></span>)"),
+        h(get_login_name), h($modify);
+    $submit = h(__("Log out"));
+    
+    print << "EOT";
+<form class="login" action="/magicat/cgi-bin/logout.cgi" method="post">
+<div class="navibar">
+$msg <input
+    type="submit" name="confirm" value="$submit" />
+</div>
+</form>
+EOT
+    return;
+}
+
+# html_nav_admin: Print the HTML administrative navigation bar
+sub html_nav_admin(;$) {
+    local ($_, %_);
+    my ($args, $cgidir, $path, $title);
+    $args = $_[0];
+    # Obtain the page parameters
+    $args = page_param $args;
+    
+    # Find the current CGI directory
+    $cgidir = "cgi-bin";
+    $cgidir = $1 if $REQUEST_PATH =~ /\/(cgi-[a-z0-9]+)\/[a-z0-9]+\.cgi$/;
+    # Output them
+    foreach my $cat (@ADMIN_SCRIPTS) {
+        @_ = qw();
+        foreach (@{$$cat{"sub"}}) {
+            next unless is_script_permitted $$_{"path"};
+            ($path, $title) = ($$_{"path"}, $$_{"title"});
+            # Fix the path to use the same cgi-* directory alias
+            $path =~ s/\/cgi-[a-z0-9]+\/([a-z0-9]+\.cgi)$/\/$cgidir\/$1/;
+            # Fix the path of the HTTPS scripts to use HTTPS
+            $path = "https://" . https_host . "/$PACKAGE$path"
+                if exists $$_{"https"} && $$_{"https"} && !is_https;
+            push @_, sprintf("    <span><a href=\"%s\">%s</a></span>",
+                    h($path), h_abbr(__($title)));
+        }
+        next if @_ == 0;
+        $title = $$cat{"title"};
+        $_ = sprintf(__("%s:"), h_abbr(__($title)));
+        print "<div class=\"navibar\">\n"
+                . $_ . "\n" . join(" |\n", @_) . "\n"
+                . "</div>\n"
+            if @_ > 0;
+    }
+    return;
+}
+
+# html_nav_page: Print the HTML page navigation bar
+sub html_nav_page(;$) {
+    local ($_, %_);
+    my ($args, $tree);
+    $args = $_[0];
+    # Obtain the page parameters
+    $args = page_param $args;
+    # Obtain the page tree
+    $tree = merged_tree $$args{"path"}, $$args{"lang"}, $$args{"preview"};
+    # Bounce for nothing
+    return if   !defined $tree
+                || !exists $$tree{"pages"}
+                || !defined $$tree{"pages"}
+                || @{$$tree{"pages"}} <= 1;
+    
+    # Output them
+    print << "EOT";
+<div class="navibar">
+EOT
+    @_ = qw();
+    foreach (@{$$tree{"pages"}}) {
+        push @_, "    <span><a href=\"" . h($$_{"path"}) . "\">"
+            . h($$_{"title"}) . "</a></span>";
+    }
+    print join(" |\n", @_) . "\n";
+    print << "EOT";
+</div>
+EOT
+    return;
+}
+
+# html_body: Print the HTML body
+sub html_body($;$) {
+    local ($_, %_);
+    my ($page, $args);
+    ($page, $args) = @_;
+    
+    # Obtain page parameters
+    $args = page_param $args;
+    
+    # Output the picture
+    # To be done
+    
+    # Output the content
+    print "" . (!exists $$page{"html"} || !$$page{"html"}?
+        a2html($$page{"body"}): $$page{"body"}) . "\n\n";
+    
+    return;
+}
+
+# html_links: Print the HTML links list
+sub html_links($;$) {
+    local ($_, %_);
+    my ($page, $args);
+    ($page, $args) = @_;
+    
+    # Obtain page parameters
+    $args = page_param $args;
+    
+    # Output the breadcrumb trai
+    @_ = qw();
+    push @_, "<a href=\"/links/\">" . h(__("Related Links")) . "</a>";
+    foreach my $parent (@{$$page{"parents"}}) {
+        push @_, "<a href=\"" . h($$parent{"path"}) . "\">"
+            . h($$parent{"title"}) . "</a>";
+    }
+    push @_, h($$page{"title"});
+    print "<div class=\"breadcrumb\">\n"
+        . join(" /\n", @_) . "\n</div>\n\n";
+    
+    # Output the subcategories
+    if (@{$$page{"scats"}} > 0) {
+        print "<h2>" . h(__("Subcategories:")) . "</h2>\n\n<ol>\n";
+        foreach my $cat (@{$$page{"scats"}}) {
+            $_ = h($$cat{"title"});
+            $_ .= " <span class=\"note\">("
+                    . h($$cat{"links"}) . ")</span>"
+                if $$cat{"links"} > 0;
+            print "<li><a href=\"" . h($$cat{"path"}) . "\">"
+                . "$_</a></li>\n";
+        }
+        print "</ol>\n\n";
+    }
+    
+    # Output the links
+    if (@{$$page{"links"}} > 0) {
+        my $emailalt;
+        $emailalt = h(__("E-mail"));
+        print "<ol class=\"linkslist\">\n";
+        foreach my $link (@{$$page{"links"}}) {
+            my ($url, $title, $ctitle, $dsc);
+            $url = h($$link{"url"});
+            $title = h($$link{"title"});
+            print "<li>\n";
+            print "<form action=\"/cgi-bin/mailto.cgi\" method=\"post\">\n<div>\n"
+                if defined $$link{"email"};
+            # Output the link icon
+            print "<a href=\"$url\"><img class=\"linkicon\"\n"
+                    . "    src=\"" . h($$link{"icon"}) . "\"\n"
+                    . "    alt=\"$title\" /></a><br />\n"
+                if defined $$link{"icon"};
+            # Output the site title
+            $ctitle = is_usascii_printable($$link{"title"})?
+                "<span class=\"en\" xml:lang=\"en\">$title</span>": $title;
+            if (defined $$link{"title_2ln"}) {
+                $_ = h($$link{"title_2ln"});
+                $_ = "<span class=\"en\" xml:lang=\"en\">$_</span>"
+                    if is_usascii_printable($$link{"title_2ln"});
+                $ctitle .= " $_";
+            }
+            print "<cite>$ctitle</cite><br />\n";
+            # Output the URL
+            print __("URL:") . " <a href=\"$url\">$url</a><br />\n";
+            # Output other information
+            if (defined $$link{"email"}) {
+                print __("E-mail:") . " ";
+                print "<input type=\"hidden\" name=\"email\" value=\""
+                    . h(mung_address_at($$link{"email"})) . "\" />\n";
+                print "<input type=\"image\" src=\"/images/email\" alt=\"$emailalt\" />\n";
+                print mung_email_span(h($$link{"email"})) . "<br />\n";
+            }
+            print __("Address:") . " " . h($$link{"addr"}) . "<br />\n"
+                if defined $$link{"addr"};
+            print __("Tel.:") . " " . h($$link{"tel"}) . "<br />\n"
+                if defined $$link{"tel"};
+            print __("Fax.:") . " " . h($$link{"fax"}) . "<br />\n"
+                if defined $$link{"fax"};
+            # Output the description
+            $dsc = $$link{"dsc"};
+            print h($dsc) . "<br />\n";
+            print "</div>\n</form>\n" if defined $$link{"email"};
+            print "</li>\n\n";
+        }
+        print "</ol>\n\n";
+    }
+    
+    return;
+}
+
+# html_links_index: Print the HTML link categories index
+sub html_links_index(\@;$) {
+    local ($_, %_);
+    my ($cats, $args);
+    ($cats, $args) = @_;
+    
+    # Obtain page parameters
+    $args = page_param $args;
+    
+    # Bounce for nothing
+    if (@$cats == 0) {
+        print "<p>" . h(__("The database is empty.")) . "</p>\n\n";
+        return;
+    }
+    
+    # Output the root categories
+    print << "EOT";
+<ul class="toc" id="toc">
+EOT
+    foreach my $cat (@$cats) {
+        $_ = h($$cat{"title"});
+        $_ .= " <span class=\"note\">("
+                . h($$cat{"links"}) . ")</span>"
+            if $$cat{"links"} > 0;
+        print "<li><a href=\"" . h($$cat{"path"}) . "\">"
+            . "$_</a></li>\n";
+    }
+    print << "EOT";
+</ul>
+
+EOT
+    return;
+}
+
+# html_legend_index: Print the HTML legend index
+sub html_legend_index(\@;$) {
+    local ($_, %_);
+    my ($pages, $args, $parent, $here);
+    ($pages, $args) = @_;
+    
+    # Obtain page parameters
+    $args = page_param $args;
+    
+    # Bounce for nothing
+    if (@$pages == 0) {
+        print "<p>" . h(__("The legend is empty.")) . "</p>\n\n";
+        return;
+    }
+    
+    # Output the index
+    $_ = h(__("Index"));
+    print << "EOT";
+<h2>$_</h2>
+
+<ul class="toc">
+EOT
+    foreach my $page (reverse @$pages) {
+        my ($title, $url, $start, $end);
+        Lingua::ZH::Numbers->charset("traditional");
+        $_ = number_to_zh($$page{"no"});
+        $title = h(sprintf __("Legend Volume %s"), $_);
+        $url = h($$page{"path"});
+        $start = h(myfmtdate $$page{"start"});
+        $end = h(myfmtdate $$page{"end"});
+        print << "EOT";
+<li><h3><a href="$url">$title</a></h3>
+<address>$start - $end</address></li>
+
+EOT
+    }
+    print << "EOT";
+</ul>
+
+EOT
+    return;
+}
+
+# html_footer: Print the HTML footer
+sub html_footer(;$) {
+    local ($_, %_);
+    my ($args, $lang);
+    $args = $_[0];
+    # Obtain the page parameters
+    $args = page_param $args;
+    $lang = $$args{"lang"};
+    
+    # Embrace the content
+    print << "EOT";
+</div>
+
+EOT
+    # Print the section-specific navigation bar
+    print "<hr />\n" . $$args{"footer_html_nav"} . "\n\n"
+        if exists $$args{"footer_html_nav"};
+    
+    # Print the common footer
+    $FOOTER{"file"} = sprintf("%s/magicat/include/footer.html", $DOC_ROOT)
+        if !exists $FOOTER{"file"};
+    undef $_;
+    if (    !exists $FOOTER{"content"}
+            || !exists $FOOTER{"date"}
+            || $FOOTER{"date"} < ($_ = (stat $FOOTER{"file"})[9])) {
+        $_ = (stat $FOOTER{"file"})[9] if !defined $_;
+        $FOOTER{"date"} = $_;
+        $FOOTER{"content"} = hcref_decode ln($lang, LN_CHARSET), xfread $FOOTER{"file"};
+    }
+    $_ = $FOOTER{"content"};
+    $FOOTER{"perl"} = {} if !exists $FOOTER{"perl"};
+    if ($$args{"static"}) {
+        s/\n+<!--selima:perl-->\n+/\n\n/;
+    } elsif ($IS_MODPERL) {
+        if (!exists ${$FOOTER{"perl"}}{"modperl"}) {
+            ${$FOOTER{"perl"}}{"modperl"} = << "EOT";
+<div class="modperl">
+<a href="http://perl.apache.org/"><img
+    src="/images/modperl" alt="%s" /></a>
+<p>%s</p>
+</div>
+EOT
+            ${$FOOTER{"perl"}}{"modperl"} = sprintf(${$FOOTER{"perl"}}{"modperl"},
+                h(__("mod_perl -- Speed, Power, Scalability")),
+                __("This script is written in <a href=\"http://www.perl.com/\"><acronym title=\"Practical Extraction and Reporting Language\">Perl</acronym></a> and optimized for <a href=\"http://perl.apache.org/\">mod_perl</a>."));
+            ${$FOOTER{"perl"}}{"modperl"} =~ s/(<a href=".+?")(>)/$1 hreflang="en"$2/g
+                if $lang ne "en";
+        }
+        s/<!--selima:perl-->\n/${$FOOTER{"perl"}}{"modperl"}/;
+    } else {
+        if (!exists ${$FOOTER{"perl"}}{"cgi"}) {
+            ${$FOOTER{"perl"}}{"cgi"} = << "EOT";
+<div>
+<p>%s</p>
+</div>
+EOT
+            ${$FOOTER{"perl"}}{"cgi"} = sprintf(${$FOOTER{"perl"}}{"cgi"},
+                __("This script is written in <a href=\"http://www.perl.com/\"><acronym title=\"Practical Extraction and Reporting Language\">Perl</acronym></a>."));
+            ${$FOOTER{"perl"}}{"cgi"} =~ s/(<a href=".+?")(>)/$1 hreflang="en"$2/g
+                if $lang ne "en";
+        }
+        s/<!--selima:perl-->\n/${$FOOTER{"perl"}}{"cgi"}/;
+    }
+    print $_;
+    
+    # Show the HTML preview mark
+    html_preview_mark $args;
+    
+    print "\n</body>\n</html>\n";
+    return;
+}
+
+# merged_tree: Get the page tree in a directory
+sub merged_tree($$;$) {
+    local ($_, %_);
+    my ($path, $lang, $preview);
+    ($path, $lang, $preview) = @_;
+    
+    # Return special areas
+    if ($path =~ /^\/links\//) {
+        return link_tree($path, $lang, $preview);
+    # Non-pages (scripts... etc)
+    } else {
+        return {};
+    }
+}
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/Items.pm

@@ -0,0 +1,93 @@
+# Mandy Wu's Website
+# Items.pm: The data record related subroutines.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-14
+
+package Selima::emandy::Items;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Exporter);
+use vars qw(@EXPORT @EXPORT_OK);
+BEGIN {
+@EXPORT = qw();
+push @EXPORT, qw(mtrltype_title mtrltype_options);
+@EXPORT_OK = @EXPORT;
+# Prototype declaration
+sub mtrltype_title($);
+sub mtrltype_options($);
+}
+
+use Selima::ChkFunc;
+use Selima::CommText;
+use Selima::DataVars qw($DBH :l10n :lninfo);
+use Selima::EchoForm;
+use Selima::GetLang;
+use Selima::LnInfo;
+
+# mtrltype_title: Obtain a material type title
+sub mtrltype_title($) {
+    local ($_, %_);
+    my ($sn, $sql, $sth, $row);
+    $sn = $_[0];
+    # Bounce if there is any problem with $sn
+    return t_notset if !defined $sn;
+    
+    # Check the serial number first
+    return t_na if !check_sn $sn;
+    
+    # Query
+    $sql = "SELECT title FROM mtrltype"
+        . " WHERE sn=$sn;\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    
+    # Not found
+    return t_na unless $sth->rows == 1;
+    
+    # Found
+    return ${$sth->fetch}[0];
+}
+
+# mtrltype_options: Obtain a material type options list
+sub mtrltype_options($) {
+    local ($_, %_);
+    my ($value, $sql, $thiscol, $defcol, $content);
+    $value = $_[0];
+
+    # Unilingual
+    if (@ALL_LINGUAS == 1) {
+        $content = "title AS content";
+    # Multilingual
+    } else {
+        $thiscol = "title_" . getlang(LN_DATABASE);
+        # Default language
+        if (getlang eq $DEFAULT_LANG) {
+            $content = "$thiscol AS content";
+        # Fall back to the default language
+        } else {
+            $defcol = "title_" . ln($DEFAULT_LANG, LN_DATABASE);
+            $content = "COALESCE($thiscol, $defcol) AS content";
+        }
+    }
+    $sql = "SELECT sn AS value, $content FROM mtrltype"
+        . " ORDER BY ord;\n";
+    return opt_list $sql, $value;
+}
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/L10N.pm

@@ -0,0 +1,38 @@
+# Mandy Wu's Website
+# L10N.pm: The localization class.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-14
+
+package Selima::emandy::L10N;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Locale::Maketext::Gettext);
+
+return 1;
+
+# The Chinese (Taiwan) localized messages.
+package Selima::emandy::L10N::zh_tw;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Locale::Maketext::Gettext);
+
+sub numerate : method { $_[2] }
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/List/Books.pm

@@ -0,0 +1,113 @@
+# Mandy Wu's Website
+# Books.pm: The book list.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-15
+
+package Selima::emandy::List::Books;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::List);
+
+use Selima::ShortCut;
+use Selima::DataVars qw(:requri);
+
+# new: Initialize the handler
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "books" if !defined $_[1];
+    $self = $class->SUPER::new(@_);
+    # The page title
+    $self->{"title"} = $self->{"is_called_form"}?
+        __("Select a Book"):
+        __("Manage Books");
+    # The default sort order
+    $self->{"DEFAULT_SORTBY"} = "title,-year,author";
+    # Columns that should display its brief instead
+    $self->{"COLS_BRIEF"} = [qw(review comment lib)];
+    # Column labels
+    $self->col_labels(
+        "author"    => __("Author"),
+        "year"      => __("Year"),
+        "origin"    => __("Origin"),
+        "pub"       => __("Publisher"),
+        "toborrow"  => __("To be borrowed?"),
+        "review"    => __("Review"),
+        "comment"   => __("Comment"),
+        "lib"       => __("Libraries"),
+    );
+    # The list switches
+    $self->{"lists_switch"} = [
+        {   "url"   => $REQUEST_FILE . "?list=nottoborrow",
+        "title" => __("Books not to be borrowed"), },
+        {   "url"   => $REQUEST_FILE . "?list=toborrow",
+        "title" => __("Books to be borrowed"), },
+        {   "url"   => $REQUEST_FILE,
+        "title" => __("All books"), },
+    ];
+    return $self;
+}
+
+# html_newlink: Display a link to add a new item
+sub html_newlink : method {
+    # Run the parent method
+    return $_[0]->SUPER::html_newlink(__("Add a new book."));
+}
+
+# html_search: Display the search box
+sub html_search : method {
+    # Run the parent method
+    return $_[0]->SUPER::html_search(__("Search for a book:"));
+}
+
+# liststat_message: Return the current list statistics message
+sub liststat_message : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    
+    # No record to list
+    if ($self->{"total"} == 0) {
+        # Inherit the empty list statistics message
+        return $self->SUPER::liststat_message;
+    # Fit in one page
+    } elsif ($self->{"total"} <= $self->{"pagesize"}) {
+        # Result comes from a query
+        if (defined $self->{"query"}) {
+            return __("Your query found [*,_1,book].", $self->{"total"});
+        # List result
+        } else {
+            return __("[*,_1,book].", $self->{"total"});
+        }
+    # More than one page
+    } else {
+        # Result comes from a query
+        if (defined $self->{"query"}) {
+            return __("Your query found [*,_1,book], listing [#,_2] to [#,_3].",
+                $self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
+        # List result
+        } else {
+            return __("[*,_1,book], listing [#,_2] to [#,_3].",
+                $self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
+        }
+    }
+}
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/List/Books/NotToBorrow.pm

@@ -0,0 +1,47 @@
+# Mandy Wu's Website
+# NotToBorrow.pm: The not-to-borrow book list.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-15
+
+package Selima::emandy::List::Books::NotToBorrow;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::emandy::List::Books);
+
+use Selima::ShortCut;
+
+# new: Initialize the handler
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "books" if !defined $_[1];
+    $self = $class->SUPER::new(@_);
+    # The page title
+    $self->{"title"} = $self->{"is_called_form"}?
+        __("Select a Book"):
+        __("Manage Books Not to Be Borrowed");
+    $self->{"view"} = "books_nottoborrow_list";
+    # Column labels
+    $self->col_labels(
+    );
+    return $self;
+}
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/List/Books/ToBorrow.pm

@@ -0,0 +1,47 @@
+# Mandy Wu's Website
+# ToBorrow.pm: The to-borrow book list.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-15
+
+package Selima::emandy::List::Books::ToBorrow;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::emandy::List::Books);
+
+use Selima::ShortCut;
+
+# new: Initialize the handler
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "books" if !defined $_[1];
+    $self = $class->SUPER::new(@_);
+    # The page title
+    $self->{"title"} = $self->{"is_called_form"}?
+        __("Select a Book"):
+        __("Manage Books to be Borrowed");
+    $self->{"view"} = "books_toborrow_list";
+    # Column labels
+    $self->col_labels(
+    );
+    return $self;
+}
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/List/Legend.pm

@@ -0,0 +1,100 @@
+# Mandy Wu's Website
+# Legend.pm: The administrative blog article list.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-15
+
+package Selima::emandy::List::Legend;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::List);
+
+use Selima::ShortCut;
+
+# new: Initialize the handler
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "legend" if !defined $_[1];
+    $self = $class->SUPER::new(@_);
+    # The page title
+    $self->{"title"} = $self->{"is_called_form"}?
+        __("Select a Legend Entry"):
+        __("Manage Legend");
+    # The default sort order
+    $self->{"DEFAULT_SORTBY"} = "created";
+    # Columns that should display its brief instead
+    $self->{"COLS_BRIEF"} = [qw(body)];
+    # Columns should be displayed in a reversed order
+    $self->{"reverse"} = 1;
+    # The list brief size
+    $self->{"DEFAULT_BRIEF_LEN"} = 20;
+    # Column labels
+    $self->col_labels(
+        "pageno"    => __("Page No."),
+    );
+    return $self;
+}
+
+# html_newlink: Display a link to add a new item
+sub html_newlink : method {
+    # Run the parent method
+    return $_[0]->SUPER::html_newlink(__("Write a new legend entry."));
+}
+
+# html_search: Display the search box
+sub html_search : method {
+    # Run the parent method
+    return $_[0]->SUPER::html_search(__("Search for a legend entry:"));
+}
+
+# liststat_message: Return the current list statistics message
+sub liststat_message : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    
+    # No record to list
+    if ($self->{"total"} == 0) {
+        # Inherit the empty list statistics message
+        return $self->SUPER::liststat_message;
+    # Fit in one page
+    } elsif ($self->{"total"} <= $self->{"pagesize"}) {
+        # Result comes from a query
+        if (defined $self->{"query"}) {
+            return __("Your query found [*,_1,legend entry,legend entries].", $self->{"total"});
+        # List result
+        } else {
+            return __("[*,_1,legend entry,legend entries].", $self->{"total"});
+        }
+    # More than one page
+    } else {
+        # Result comes from a query
+        if (defined $self->{"query"}) {
+            return __("Your query found [*,_1,legend entry,legend entries], listing [#,_2] to [#,_3].",
+                $self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
+        # List result
+        } else {
+            return __("[*,_1,legend entry,legend entries], listing [#,_2] to [#,_3].",
+                $self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
+        }
+    }
+}
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/List/Legend/Public.pm

@@ -0,0 +1,152 @@
+# Mandy Wu's Website
+# Public.pm: The blog article list.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-15
+
+package Selima::emandy::List::Legend::Public;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::List);
+
+use IO::NestedCapture qw(CAPTURE_STDOUT);
+
+use Selima::A2HTML;
+use Selima::DataVars qw($DBH);
+use Selima::Format;
+use Selima::ShortCut;
+
+# new: Initialize the handler
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "legend" if !defined $_[1];
+    $self = $class->SUPER::new(@_);
+    # Columns should be displayed in a reversed order
+    $self->{"reverse"} = 1;
+    # These are static pages
+    $self->{"static"} = 1;
+    $self->{"static_lastfile"} = "latest.html";
+    return $self;
+}
+
+# fetch: Fetch the current list
+sub fetch : method {
+    local ($_, %_);
+    my ($self, $table, $sth, $sql, $error);
+    $self = $_[0];
+    
+    # Fetched before
+    return $self->{"error"} if $self->{"fetched"};
+    $self->{"fetched"} = 1;
+    
+    # Initialize the error status
+    $self->{"error"} = undef;
+    
+    # The view name
+    $table = $DBH->quote_identifier($self->{"view"});
+    
+    # Obtain everything in this page
+    $self->{"current"} = [];
+    # Always reverse
+    $self->{"select"} = "SELECT * FROM $table"
+        . " WHERE pageno=" . $self->{"pageno"} . ";\n";
+    $sql = $self->{"select"};
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    push @{$self->{"current"}}, $_
+        while defined($_ = $sth->fetchrow_hashref);
+    undef $sth;
+    
+    # Done
+    return $self->{"error"};
+}
+
+# page_param: Obtain page parameters
+sub page_param : method {
+    local ($_, %_);
+    my ($self, $args);
+    $self = $_[0];
+    # Run the parent method
+    $args = $self->SUPER::page_param;
+    # Add the page bar to the page parameters
+    if (defined $args && $self->{"lastpage"} > 1) {
+        my $FD;
+        # Obtain the page bar
+        IO::NestedCapture->start(CAPTURE_STDOUT);
+        binmode IO::NestedCapture->instance->{"STDOUT_current"}[-1], ":utf8";
+        $self->html_pagebar;
+        IO::NestedCapture->stop(CAPTURE_STDOUT);
+        $FD = IO::NestedCapture->get_last_out;
+        $$args{"header_html_nav"} = join "", <$FD>;
+        $$args{"header_html_nav"} =~ s/\s+$//;
+        $$args{"footer_html_nav"} = $$args{"header_html_nav"};
+    }
+    return $args;
+}
+
+# html: Output the list
+sub html : method {
+    local ($_, %_);
+    my ($self, $args);
+    ($self, $args) = @_;
+    # Obtain the page parameters
+    $args = Selima::PageFunc::page_param $args;
+    # Fetch the current list if not fetched yet
+    $self->fetch if !$self->{"fetched"};
+    
+    # List the items
+    $self->html_list($args);
+    
+    return;
+}
+
+# html_list: List the items
+sub html_list : method {
+    local ($_, %_);
+    my ($self, $args, @htmls);
+    ($self, $args) = @_;
+    # Obtain the page parameters
+    $args = Selima::PageFunc::page_param $args;
+    # No record to be listed
+    return if $self->{"total"} == 0;
+    
+    foreach my $current (@{$self->{"current"}}) {
+        my $h;
+        $h = "";
+        $h .= "<div id=\"ent" . a2html($$current{"sn"}) . "\" class=\"entry\">\n";
+        $h .= "<address>" . myfmttime($$current{"date"}) . "</address>\n\n";
+        $h .= "<h2>" . h($$current{"title"}) . "</h2>\n\n";
+        if ($$current{"html"}) {
+            $h .= $$current{"body"} . "\n\n";
+        } else {
+            $h .= "<div class=\"freetext\">\n" . a2html($$current{"body"}) . "\n</div>\n\n";
+        }
+        $h .= "</div>\n\n";
+        push @htmls, $h;
+    }
+    
+    $_ = h(__("The legend entry seperator"));
+    print "<div class=\"entries\">\n\n"
+        . join("<hr title=\"$_\" />\n\n", @htmls) . "</div>\n\n";
+    
+    return;
+}
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/List/Material.pm

@@ -0,0 +1,100 @@
+# Mandy Wu's Website
+# Material.pm: The historical material list.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-23
+
+package Selima::emandy::List::Material;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::List);
+
+use Selima::ShortCut;
+
+# new: Initialize the handler
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "material" if !defined $_[1];
+    $self = $class->SUPER::new(@_);
+    # The page title
+    $self->{"title"} = $self->{"is_called_form"}?
+        __("Select a Material"):
+        __("Manage Materials");
+    # The default sort order
+    $self->{"DEFAULT_SORTBY"} = "title";
+    # Columns that should display its brief instead
+    $self->{"COLS_BRIEF"} = [qw(body notes)];
+    # Column labels
+    $self->col_labels(
+        "type"      => __("Type"),
+        "year"      => __("Year"),
+        "source"    => __("Source"),
+        "author"    => __("Author"),
+        "notes"     => __("Notes"),
+    );
+    return $self;
+}
+
+# html_newlink: Display a link to add a new item
+sub html_newlink : method {
+    # Run the parent method
+    return $_[0]->SUPER::html_newlink(__("Add a new material."));
+}
+
+# html_search: Display the search box
+sub html_search : method {
+    # Run the parent method
+    return $_[0]->SUPER::html_search(__("Search for a material:"));
+}
+
+# liststat_message: Return the current list statistics message
+sub liststat_message : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    
+    # No record to list
+    if ($self->{"total"} == 0) {
+        # Inherit the empty list statistics message
+        return $self->SUPER::liststat_message;
+    # Fit in one page
+    } elsif ($self->{"total"} <= $self->{"pagesize"}) {
+        # Result comes from a query
+        if (defined $self->{"query"}) {
+            return __("Your query found [*,_1,material].", $self->{"total"});
+        # List result
+        } else {
+            return __("[*,_1,material].", $self->{"total"});
+        }
+    # More than one page
+    } else {
+        # Result comes from a query
+        if (defined $self->{"query"}) {
+            return __("Your query found [*,_1,material], listing [#,_2] to [#,_3].",
+                $self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
+        # List result
+        } else {
+            return __("[*,_1,material], listing [#,_2] to [#,_3].",
+                $self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
+        }
+    }
+}
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/List/MtrlType.pm

@@ -0,0 +1,93 @@
+# Mandy Wu's Website
+# MtrlType.pm: The historical material type list.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-23
+
+package Selima::emandy::List::MtrlType;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::List);
+
+use Selima::ShortCut;
+
+# new: Initialize the handler
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "mtrltype" if !defined $_[1];
+    $self = $class->SUPER::new(@_);
+    # The page title
+    $self->{"title"} = $self->{"is_called_form"}?
+        __("Select a Material Type"):
+        __("Manage Material Types");
+    # The default sort order
+    $self->{"DEFAULT_SORTBY"} = "ord,title";
+    # Column labels
+    $self->col_labels(
+    );
+    return $self;
+}
+
+# html_newlink: Display a link to add a new item
+sub html_newlink : method {
+    # Run the parent method
+    return $_[0]->SUPER::html_newlink(__("Add a new type."));
+}
+
+# html_search: Display the search box
+sub html_search : method {
+    # Run the parent method
+    return $_[0]->SUPER::html_search(__("Search for a type:"));
+}
+
+# liststat_message: Return the current list statistics message
+sub liststat_message : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    
+    # No record to list
+    if ($self->{"total"} == 0) {
+        # Inherit the empty list statistics message
+        return $self->SUPER::liststat_message;
+    # Fit in one page
+    } elsif ($self->{"total"} <= $self->{"pagesize"}) {
+        # Result comes from a query
+        if (defined $self->{"query"}) {
+            return __("Your query found [*,_1,type].", $self->{"total"});
+        # List result
+        } else {
+            return __("[*,_1,type].", $self->{"total"});
+        }
+    # More than one page
+    } else {
+        # Result comes from a query
+        if (defined $self->{"query"}) {
+            return __("Your query found [*,_1,type], listing [#,_2] to [#,_3].",
+                $self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
+        # List result
+        } else {
+            return __("[*,_1,type], listing [#,_2] to [#,_3].",
+                $self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
+        }
+    }
+}
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/List/Search.pm

@@ -0,0 +1,179 @@
+# Mandy Wu's Website
+# Search.pm: The web site full-text search result list.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-14
+
+package Selima::emandy::List::Search;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::List);
+
+use Selima::Logging;
+use Selima::ShortCut;
+
+# new: Initialize the handler
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $self = $class->SUPER::new(@_);
+    # The page title
+    if (!defined $self->{"query"}) {
+        $self->{"title"} = __("Full Text Search");
+    } else {
+        $self->{"title"} = __("Search Result");
+    }
+    $self->{"view"} = "search_list";
+    $self->{"COLS_NO_SEARCH"} = [qw(section path date html)];
+    return $self;
+}
+
+# fetch: Fetch the current list
+sub fetch : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # No search specified
+    if (!defined $self->{"query"}) {
+        $self->{"total"} = undef;
+        return $self->{"error"};
+    }
+    # Check the query phrase
+    # Regularize it
+    $self->{"query"} =~ s/^\s*(.*?)\s*$/$1/;
+    # Check if it is filled
+    if ($self->{"query"} eq"") {
+        $self->{"total"} = undef;
+        $self->{"error"} = {"msg"=>N_("Please fill in your query.")};
+        return $self->{"error"};
+    }
+    # Run the parent method
+    $self->SUPER::fetch;
+    # Add an activity log record
+    actlog("Query with phrase \"" . $self->{"query"} . "\".");
+    # Done
+    return $self->{"error"};
+}
+
+# sql_orderby: Get the SQL ORDER BY phase
+# Always return nothing
+sub sql_orderby : method { return ""; }
+
+# html_newlink: Display a link to add a new item
+# Make it a null function
+sub html_newlink : method {}
+
+# html_search: Display the search box
+sub html_search : method {
+    # Run the parent method
+    return $_[0]->SUPER::html_search(__("Search in the website:"));
+}
+
+# liststat_message: Return the current list statistics message
+sub liststat_message : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    
+    # No record to list
+    if ($self->{"total"} == 0) {
+        # Inherit the empty list statistics message
+        return $self->SUPER::liststat_message;
+    # Fit in one page
+    } elsif ($self->{"total"} <= $self->{"pagesize"}) {
+        # Result comes from a query
+        if (defined $self->{"query"}) {
+            return __("Your query found [*,_1,article].", $self->{"total"});
+        # List result
+        } else {
+            return __("[*,_1,article].", $self->{"total"});
+        }
+    # More than one page
+    } else {
+        # Result comes from a query
+        if (defined $self->{"query"}) {
+            return __("Your query found [*,_1,article], listing [#,_2] to [#,_3].",
+                $self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
+        # List result
+        } else {
+            return __("[*,_1,article], listing [#,_2] to [#,_3].",
+                $self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
+        }
+    }
+}
+
+# html_list: List the items
+sub html_list : method {
+    local ($_, %_);
+    my ($self);
+    $self = $_[0];
+    # Do not show the list
+    return if !defined $self->{"total"};
+    # No record to be listed
+    return if $self->{"total"} == 0;
+    
+    print << "EOT";
+<ol class="searchresult">
+EOT
+    
+    # Print each record
+    foreach my $current (@{$self->{"current"}}) {
+        my ($url, $abstract);
+        $url = h($$current{"path"});
+        $abstract = $self->query_abstract($current);
+        if ($$current{"section"} eq "pages") {
+            my $title;
+            $title = h($$current{"title"});
+            
+            print << "EOT";
+<li><h3><a href="$url">$title</a></h3>
+EOT
+        } elsif ($$current{"section"} eq "links") {
+            my ($title, $sectitle);
+            $title = h($$current{"title"});
+            $sectitle = h(__("Related Links"));
+            
+            print << "EOT";
+<li><h3><a href="$url">$title</a></h3>
+<address><a href="/links/">$sectitle</a></address>
+EOT
+        } elsif ($$current{"section"} eq "legend") {
+            my ($title, $sectitle);
+            $title = h($$current{"title"});
+            $sectitle = h(__("Legend"));
+            
+            print << "EOT";
+<li><h3><a href="$url">$title</a></h3>
+<address><a href="/legend/">$sectitle</a></address>
+EOT
+        }
+        print "\n<p>$abstract</p>\n" if defined $abstract;
+        print << "EOT";
+</li>
+
+EOT
+    }
+    print << "EOT";
+</ol>
+
+EOT
+    return;
+}
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/Processor/Book.pm

@@ -0,0 +1,121 @@
+# Mandy Wu's Website
+# Book.pm: The book data processor.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-15
+
+package Selima::emandy::Processor::Book;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor);
+
+use Selima::DataVars qw($DBH :addcol);
+use Selima::Format;
+use Selima::Guest;
+use Selima::ShortCut;
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "books" if @_ < 2;
+    $self = $class->SUPER::new(@_);
+    return $self;
+}
+
+# _save_cols: Save the column deposit
+sub _save_cols : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    if ($self->{"type"} eq "new") {
+        $self->{"sn"} = $self->_new_sn;
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_INSERT);
+        $self->{"cols"}->addnum("sn", $self->{"sn"});
+        $self->{"cols"}->addstr("title", $self->_form("title"));
+        $self->{"cols"}->addstr("author", $self->_form("author"));
+        $self->{"cols"}->addnum("year", $self->_form("year"));
+        $self->{"cols"}->addstr("origin", $self->_form("origin"));
+        $self->{"cols"}->addstr("pub", $self->_form("pub"));
+        $self->{"cols"}->addbool("toborrow", $self->_form("toborrow"));
+        $self->{"cols"}->addstr("review", $self->_form("review"));
+        $self->{"cols"}->addstr("comment", $self->_form("comment"));
+        $self->{"cols"}->addstr("lib", $self->_form("lib"));
+    
+    # A form to edit a current item
+    } elsif ($self->{"type"} eq "cur") {
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
+        $self->{"cols"}->addstr("title", $self->_form("title"), scalar $cur->param("title"));
+        $self->{"cols"}->addstr("author", $self->_form("author"), scalar $cur->param("author"));
+        $self->{"cols"}->addnum("year", $self->_form("year"), scalar $cur->param("year"));
+        $self->{"cols"}->addstr("origin", $self->_form("origin"), scalar $cur->param("origin"));
+        $self->{"cols"}->addstr("pub", $self->_form("pub"), scalar $cur->param("pub"));
+        $self->{"cols"}->addbool("toborrow", $self->_form("toborrow"), scalar $cur->param("toborrow"));
+        $self->{"cols"}->addstr("review", $self->_form("review"), scalar $cur->param("review"));
+        $self->{"cols"}->addstr("comment", $self->_form("comment"), scalar $cur->param("comment"));
+        $self->{"cols"}->addstr("lib", $self->_form("lib"), scalar $cur->param("lib"));
+    }
+    return;
+}
+
+# _actlog: Log the activity
+sub _actlog : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    return gactlog "Create a book \"" . $form->param("title") . "\""
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return gactlog "Update the book \"" . $form->param("title") . "\""
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return gactlog "Delete the book \"" . $cur->param("title") . "\""
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "del";
+}
+
+# _ret_status: Return the process status
+sub _ret_status : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    return {"msg"=>N_("This book was not modified."),
+            "isform"=>0}
+        if !$self->_modified;
+    # A form to create a new item
+    return {"msg"=>N_("This book has been successfully added."),
+            "isform"=>0}
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return {"msg"=>N_("This book has been successfully updated."),
+            "isform"=>0}
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return {"msg"=>N_("This book has been successfully deleted."),
+            "isform"=>0}
+        if $self->{"type"} eq "del";
+}
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/Processor/Legend.pm

@@ -0,0 +1,191 @@
+# Mandy Wu's Website
+# Legend.pm: The blog article data processor.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-15
+
+package Selima::emandy::Processor::Legend;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor::Guestbook);
+
+use Selima::DataVars qw($DBH :addcol);
+use Selima::Format;
+use Selima::Guest;
+use Selima::ShortCut;
+
+use Selima::emandy::Rebuild;
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "legend" if @_ < 2;
+    $self = $class->SUPER::new(@_);
+    $self->{"form_cols"} = [qw(title body)];
+    return $self;
+}
+
+# _save_cols: Save the column deposit
+sub _save_cols : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    if ($self->{"type"} eq "new") {
+        $self->{"sn"} = $self->_new_sn;
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_INSERT);
+        $self->{"cols"}->addnum("sn", $self->{"sn"});
+        $self->{"cols"}->addstr("title", $self->_form("title"));
+        $self->{"cols"}->addstr("body", $self->_form("body"));
+        $self->{"cols"}->addbool("html", $self->_form("html"));
+        $self->{"cols"}->addbool("hid", $self->_form("hid"));
+        $self->{"cols"}->addnum("pageno", 1);
+    
+    # A form to edit a current item
+    } elsif ($self->{"type"} eq "cur") {
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
+        $self->{"cols"}->addstr("title", $self->_form("title"), scalar $cur->param("title"));
+        $self->{"cols"}->addstr("body", $self->_form("body"), scalar $cur->param("body"));
+        $self->{"cols"}->addbool("html", $self->_form("html"), scalar $cur->param("html"));
+        $self->{"cols"}->addbool("hid", $self->_form("hid"), scalar $cur->param("hid"));
+    }
+    return;
+}
+
+# _update_cols: Update the columns
+sub _update_cols : method {
+    local ($_, %_);
+    my $self;
+    ($self, @_) = @_;
+    $self->{"curlast"} = $self->_last_page;
+    $self->SUPER::_update_cols(@_);
+    return;
+}
+
+# _actlog: Log the activity
+sub _actlog : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    # A form to create a new item
+    return gactlog "Create a legend entry on " . fmtdate($self->{"date"})
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return gactlog "Update the legend entry on " . fmtdate($self->{"date"})
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return gactlog "Delete the legend entry on " . fmtdate($self->{"date"})
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "del";
+}
+
+# _ret_status: Return the process status
+sub _ret_status : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    return {"msg"=>N_("This legend entry was not modified."),
+            "isform"=>0}
+        if !$self->_modified;
+    # A form to create a new item
+    return {"msg"=>N_("This legend entry has been successfully added."),
+            "isform"=>0}
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return {"msg"=>N_("This legend entry has been successfully updated."),
+            "isform"=>0}
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return {"msg"=>N_("This legend entry has been successfully deleted."),
+            "isform"=>0}
+        if $self->{"type"} eq "del";
+}
+
+# _rebuild_partial_pages: Rebuild a limited part of pages
+sub _rebuild_partial_pages : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    my ($pageno, $is_rebuild);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    
+    # Check if there is any shown part affected
+    $is_rebuild = 0;
+    # A form to create a new item
+    if ($self->{"type"} eq "new") {
+        $is_rebuild = 1 unless defined $form->param("hid");
+    # A form to edit a current item
+    } elsif ($self->{"type"} eq "cur") {
+        $is_rebuild = 1 unless defined $form->param("hid");
+        $is_rebuild = 1 unless $cur->param("hid");
+    # A form to delete a current item
+    } elsif ($self->{"type"} eq "del") {
+        $is_rebuild = 1 unless $cur->param("hid");
+    }
+    # Nothing to rebuild when no shown parts are modified
+    return unless $is_rebuild;
+    
+    # Find the page number of the current entry
+    $self->{"newlast"} = $self->_last_page;
+    # Remove the unwanted pages
+    $self->_remove_curfile;
+    $pageno = ($self->{"type"} eq "new")?
+        $self->{"newlast"}: $cur->param("pageno");
+    # If last page changed, we build from its previous page
+    if ($self->{"curlast"} < $self->{"newlast"}) {
+        $pageno = $self->{"curlast"} - 1 if $pageno > $self->{"curlast"} - 1;
+    } elsif ($self->{"curlast"} > $self->{"newlast"}) {
+        $pageno = $self->{"newlast"} - 1 if $pageno > $self->{"newlast"} - 1;
+    }
+    
+    # Rebuild the pages
+    rebuild_legend $pageno;
+    return;
+}
+
+# _remove_curfile: Remove the unwanted page
+sub _remove_curfile : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    for ($_ = $self->{"curlast"}; $_ > $self->{"newlast"}; $_--) {
+        grmoldfile sprintf "/legend/%04d.html", $_;
+    }
+    return;
+}
+
+# _last_page: Find the current last page
+sub _last_page : method {
+    local ($_, %_);
+    my ($self, $sql, $sth);
+    $self = $_[0];
+    $sql = "SELECT pageno FROM " . $self->{"table"}
+        . " WHERE NOT hid"
+        . " ORDER BY pageno DESC LIMIT 1;\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    return 1 if $sth->rows == 0;
+    return ${$sth->fetchrow_hashref}{"pageno"};
+}
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/Processor/Material.pm

@@ -0,0 +1,117 @@
+# Mandy Wu's Website
+# Material.pm: The historical material data processor.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-23
+
+package Selima::emandy::Processor::Material;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor);
+
+use Selima::DataVars qw($DBH :addcol);
+use Selima::Format;
+use Selima::Guest;
+use Selima::ShortCut;
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "material" if @_ < 2;
+    $self = $class->SUPER::new(@_);
+    return $self;
+}
+
+# _save_cols: Save the column deposit
+sub _save_cols : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    if ($self->{"type"} eq "new") {
+        $self->{"sn"} = $self->_new_sn;
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_INSERT);
+        $self->{"cols"}->addnum("sn", $self->{"sn"});
+        $self->{"cols"}->addnum("type", $self->_form("type"));
+        $self->{"cols"}->addnum("year", $self->_form("year"));
+        $self->{"cols"}->addstr("title", $self->_form("title"));
+        $self->{"cols"}->addstr("body", $self->_form("body"));
+        $self->{"cols"}->addstr("source", $self->_form("source"));
+        $self->{"cols"}->addstr("author", $self->_form("author"));
+        $self->{"cols"}->addstr("notes", $self->_form("notes"));
+    
+    # A form to edit a current item
+    } elsif ($self->{"type"} eq "cur") {
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
+        $self->{"cols"}->addnum("type", $self->_form("type"), scalar $cur->param("type"));
+        $self->{"cols"}->addnum("year", $self->_form("year"), scalar $cur->param("year"));
+        $self->{"cols"}->addstr("title", $self->_form("title"), scalar $cur->param("title"));
+        $self->{"cols"}->addstr("body", $self->_form("body"), scalar $cur->param("body"));
+        $self->{"cols"}->addstr("source", $self->_form("source"), scalar $cur->param("source"));
+        $self->{"cols"}->addstr("author", $self->_form("author"), scalar $cur->param("author"));
+        $self->{"cols"}->addstr("notes", $self->_form("notes"), scalar $cur->param("notes"));
+    }
+    return;
+}
+
+# _actlog: Log the activity
+sub _actlog : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    return gactlog "Create a material \"" . $form->param("title") . "\""
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return gactlog "Update the material \"" . $form->param("title") . "\""
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return gactlog "Delete the material \"" . $cur->param("title") . "\""
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "del";
+}
+
+# _ret_status: Return the process status
+sub _ret_status : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    return {"msg"=>N_("This material was not modified."),
+            "isform"=>0}
+        if !$self->_modified;
+    # A form to create a new item
+    return {"msg"=>N_("This material has been successfully added."),
+            "isform"=>0}
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return {"msg"=>N_("This material has been successfully updated."),
+            "isform"=>0}
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return {"msg"=>N_("This material has been successfully deleted."),
+            "isform"=>0}
+        if $self->{"type"} eq "del";
+}
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/Processor/MtrlType.pm

@@ -0,0 +1,107 @@
+# Mandy Wu's Website
+# MtrlType.pm: The historical material type data processor.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-23
+
+package Selima::emandy::Processor::MtrlType;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Selima::Processor);
+
+use Selima::DataVars qw($DBH :addcol);
+use Selima::Format;
+use Selima::Guest;
+use Selima::ShortCut;
+
+# new: Initialize the processor
+sub new : method {
+    local ($_, %_);
+    my ($self, $class);
+    ($class, @_) = @_;
+    $_[1] = "mtrltype" if @_ < 2;
+    $self = $class->SUPER::new(@_);
+    return $self;
+}
+
+# _save_cols: Save the column deposit
+sub _save_cols : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    if ($self->{"type"} eq "new") {
+        $self->{"sn"} = $self->_new_sn;
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_INSERT);
+        $self->{"cols"}->addnum("sn", $self->{"sn"});
+        $self->{"cols"}->addnum("ord", $self->_form("ord"));
+        $self->{"cols"}->addstr("title", $self->_form("title"));
+    
+    # A form to edit a current item
+    } elsif ($self->{"type"} eq "cur") {
+        $self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
+        $self->{"cols"}->addnum("ord", $self->_form("ord"), scalar $cur->param("ord"));
+        $self->{"cols"}->addstr("title", $self->_form("title"), scalar $cur->param("title"));
+    }
+    return;
+}
+
+# _actlog: Log the activity
+sub _actlog : method {
+    local ($_, %_);
+    my ($self, $form, $cur);
+    $self = $_[0];
+    ($form, $cur) = ($self->{"form"}, $self->{"cur"});
+    # A form to create a new item
+    return gactlog "Create a material type \"" . $form->param("title") . "\""
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return gactlog "Update the material type \"" . $form->param("title") . "\""
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return gactlog "Delete the material type \"" . $cur->param("title") . "\""
+            . " with s/n " . $self->{"sn"} . "."
+        if $self->{"type"} eq "del";
+}
+
+# _ret_status: Return the process status
+sub _ret_status : method {
+    local ($_, %_);
+    my $self;
+    $self = $_[0];
+    return {"msg"=>N_("This type was not modified."),
+            "isform"=>0}
+        if !$self->_modified;
+    # A form to create a new item
+    return {"msg"=>N_("This type has been successfully added."),
+            "isform"=>0}
+        if $self->{"type"} eq "new";
+    # A form to edit a current item
+    return {"msg"=>N_("This type has been successfully updated."),
+            "isform"=>0}
+        if $self->{"type"} eq "cur";
+    # A form to delete a current item
+    return {"msg"=>N_("This type has been successfully deleted."),
+            "isform"=>0}
+        if $self->{"type"} eq "del";
+}
+
+return 1;

htdocs/emandy/magicat/lib/perl5/Selima/emandy/Rebuild.pm

@@ -0,0 +1,436 @@
+# Mandy Wu's Website
+# Rebuild.pm: The subroutines to rebuild the web pages.
+
+#  Copyright (c) 2006-2018 imacat.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#      http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+
+# Author: imacat <imacat@mail.imacat.idv.tw>
+# First written: 2006-11-14
+
+package Selima::emandy::Rebuild;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Exporter);
+use vars qw(@EXPORT @EXPORT_OK);
+BEGIN {
+@EXPORT = qw(rebuild_all rebuild_pages rebuild_links rebuild_legend compose_page);
+@EXPORT_OK = @EXPORT;
+# Prototype declaration
+sub rebuild_all();
+sub rebuild_pages(;$);
+sub rebuild_links(;$);
+sub rebuild_legend(;$);
+sub compose_page($;$);
+}
+
+use Config qw(%Config);
+use Data::Dumper qw();
+use Fcntl qw(:flock);
+use File::Basename qw(basename);
+use IO::NestedCapture qw(CAPTURE_STDOUT);
+use Lingua::ZH::Numbers;
+
+use Selima::DataVars qw($DBH :output :rebuild :requri);
+use Selima::GetLang;
+use Selima::Guest;
+use Selima::PageFunc;
+use Selima::ShortCut;
+
+use Selima::emandy::HTML;
+
+use vars qw($PKGL10N);
+
+# rebuild_all: Rebuild everything
+sub rebuild_all() {
+    local ($_, %_);
+    # Lock the required tables
+    $DBH->lock(map { $_ => LOCK_SH } @REBUILD_TABLES);
+    # Rebuild the pages
+    rebuild_pages;
+    # Rebuild the links
+    rebuild_links;
+    # Rebuild the legend
+    rebuild_legend;
+    # Rebuild the index
+    # To be done
+    #rebuild_index;
+    return;
+}
+
+# rebuild_pages: Rebuild the pages
+sub rebuild_pages(;$) {
+    local ($_, %_);
+    my ($sql, $sth, $count, $rebuild_everything);
+    my $lang;
+    $sql = $_[0];
+    
+    $lang = getlang;
+    
+    # Rebuild everything
+    $rebuild_everything = !defined $sql;
+    if ($rebuild_everything) {
+        $sql = "SELECT * FROM pages"
+            . " WHERE NOT hid;\n";
+    }
+    
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    $count = $sth->rows;
+    # Bounce if no pages to build on a partial rebuild
+    # This prevents needless sitemap rebuilding
+    return if !$rebuild_everything && $count == 0;
+    # Build each page
+    for (my $i = 0; $i < $count; $i++) {
+        my ($page, $html);
+        $page = $sth->fetchrow_hashref;
+        # Read the picture into the picture deposit
+        # To be done
+        
+        $html = compose_page($page, $lang);
+        goutpage $html, $$page{"path"}, $lang
+            if defined $html;
+        
+        # Output related pictures only when rebuilding everything
+        # To be done
+    }
+    
+    return;
+}
+
+# rebuild_links: Rebuild the links
+sub rebuild_links(;$) {
+    local ($_, %_);
+    my ($sql, $sth, $count, $FD, $rebuild_everything);
+    my ($lang, $args, $html);
+    $sql = $_[0];
+    
+    $lang = getlang;
+    
+    # Rebuild everything
+    $rebuild_everything = !defined $sql;
+    if ($rebuild_everything) {
+        @_ = $DBH->cols("linkcat");
+        push @_, $DBH->strcat("'/links'", "linkcat_path(sn, id, parent)")
+          . " AS path";
+        $sql = "SELECT " . join(", ", @_) . " FROM linkcat"
+            . " WHERE linkcat_isshown(sn, hid, parent);\n";
+    }
+    
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    $count = $sth->rows;
+    for (my $i = 0; $i < $count; $i++) {
+        my ($page, $sql1, $sth1, $count1, $row1);
+        $page = $sth->fetchrow_hashref;
+        
+        # Find the ancesters
+        @_ = $DBH->cols("linkcat");
+        push @_, $DBH->strcat("'/links'", "linkcat_path(sn, id, parent)")
+          . " AS path";
+        $sql1 = "SELECT " . join(", ", @_) . " FROM linkcat"
+            . " WHERE linkcat_ischild(sn, " . $$page{"sn"} . ")"
+            . " ORDER BY linkcat_fullord(parent, ord);\n";
+        $sth1 = $DBH->prepare($sql1);
+        $sth1->execute;
+        $count1 = $sth1->rows;
+        for (my $i = 0, $$page{"parents"} = []; $i < $count1; $i++) {
+            push @{$$page{"parents"}}, $sth1->fetchrow_hashref;
+        }
+        
+        # Find the subcategories
+        @_ = $DBH->cols("linkcat");
+        push @_, $DBH->strcat("'/links'", "linkcat_path(sn, id, parent)")
+          . " AS path";
+        $sql1 = "SELECT " . join(", ", @_) . " FROM linkcat"
+            . " WHERE parent=" . $$page{"sn"}
+            . " AND linkcat_isshown(sn, hid, parent)"
+            . " ORDER BY ord;\n";
+        $sth1 = $DBH->prepare($sql1);
+        $sth1->execute;
+        $count1 = $sth1->rows;
+        for (my $i = 0, $$page{"scats"} = []; $i < $count1; $i++) {
+            my ($sql2, $sth2, $row2);
+            $row1 = $sth1->fetchrow_hashref;
+            # Find the belonging links
+            $sql2 = "SELECT count(linkcatz.sn) AS count FROM linkcatz"
+                . " INNER JOIN links ON linkcatz.link=links.sn"
+                . " INNER JOIN linkcat ON linkcatz.cat=linkcat.sn"
+                . " WHERE linkcatz.cat=" . $$row1{"sn"}
+                . " AND NOT links.hid;\n";
+            $sth2 = $DBH->prepare($sql2);
+            $sth2->execute;
+            $row2 = $sth2->fetchrow_hashref;
+            $$row1{"links"} = $$row2{"count"};
+            push @{$$page{"scats"}}, $row1;
+        }
+        
+        # Find the belonging links
+        @_ = map "links.$_", $DBH->cols("links");
+        $sql1 = "SELECT " . join(", ", @_) . " FROM links"
+            . " INNER JOIN linkcatz ON linkcatz.link=links.sn"
+            . " WHERE linkcatz.cat=" . $$page{"sn"}
+            . " AND NOT links.hid;\n";
+        $sth1 = $DBH->prepare($sql1);
+        $sth1->execute;
+        $count1 = $sth1->rows;
+        for (my $i = 0, $$page{"links"} = []; $i < $count1; $i++) {
+            push @{$$page{"links"}}, $sth1->fetchrow_hashref;
+        }
+        
+        $html = compose_page($page, $lang);
+        goutpage $html, $$page{"path"}, $lang
+            if defined $html;
+    }
+    
+    # Build the root index page
+    @_ = $DBH->cols("linkcat");
+    push @_, $DBH->strcat("'/links'", "linkcat_path(sn, id, parent)")
+      . " AS path";
+    $sql = "SELECT " . join(", ", @_) . " FROM linkcat"
+        . " WHERE parent IS NULL"
+        . " AND linkcat_isshown(sn, hid, parent)"
+        . " ORDER BY ord;\n";
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    $count = $sth->rows;
+    for ($_ = 0, @_ = qw(); $_ < $count; $_++) {
+        my ($cat, $sql1, $sth1, $count1);
+        $cat = $sth->fetchrow_hashref;
+        
+        # Find the belonging links
+        $sql1 = "SELECT count(linkcatz.sn) AS count FROM linkcatz"
+            . " INNER JOIN links ON linkcatz.link=links.sn"
+            . " INNER JOIN linkcat ON linkcatz.cat=linkcat.sn"
+            . " WHERE linkcatz.cat=" . $$cat{"sn"}
+            . " AND NOT links.hid;\n";
+        $sth1 = $DBH->prepare($sql1);
+        $sth1->execute;
+        $$cat{"links"} = ${$sth1->fetch}[0];
+        
+        push @_, $cat;
+    }
+    $ALT_PAGE_PARAM = {
+        "path"          => "/links/",
+        "lang"          => $lang,
+        "keywords"      => __("related links"),
+        "class"         => "links",
+        "static"        => 1,
+        "all_linguas"   => [$lang]};
+    $args = page_param;
+    # Obtain the page
+    IO::NestedCapture->start(CAPTURE_STDOUT);
+    binmode IO::NestedCapture->instance->{"STDOUT_current"}[-1], ":utf8";
+    html_header __("Related Links"), $args;
+    html_links_index @_, $args;
+    html_footer $args;
+    IO::NestedCapture->stop(CAPTURE_STDOUT);
+    $FD = IO::NestedCapture->get_last_out;
+    $html = join "", <$FD>;
+    undef $ALT_PAGE_PARAM;
+    goutpage $html, "/links/", $lang;
+    
+    return;
+}
+
+# rebuild_legend: Rebuild the legend
+sub rebuild_legend(;$) {
+    local ($_, %_);
+    my ($start, $sql, $sth, $count, $FD, $page, @pages, $total);
+    my ($lang, $args, $html);
+    $start = $_[0];
+    $start = 1 if !defined $start;
+    
+    $lang = getlang;
+    
+    # Obtain the total number of legend entries
+    $_ = "SELECT count(*) FROM legend WHERE NOT hid;\n";
+    $sth = $DBH->prepare($_);
+    $sth->execute;
+    $total = ${$sth->fetch}[0];
+    
+    # Obtain all the available pages numbers
+    @_ = qw();
+    push @_, "pageno AS no";
+    push @_, "legend_page_start(pageno) AS start";
+    push @_, "legend_page_end(pageno) AS end";
+    $sql = "SELECT " . join(", ", @_) . " FROM legend"
+        . " WHERE NOT hid GROUP BY pageno ORDER BY pageno;\n";
+    
+    $sth = $DBH->prepare($sql);
+    $sth->execute;
+    $count = $sth->rows;
+    for (my $i = 0, @pages = qw(); $i < $count; $i++) {
+        $page = $sth->fetchrow_hashref;
+        $$page{"path"} = sprintf "/legend/%04d.html", $$page{"no"};
+        push @pages, $page;
+    }
+    
+    # Build each page
+    foreach my $page (@pages) {
+        next if $$page{"no"} < $start;
+        
+        my ($args, $LIST, $html, $FD);
+        Lingua::ZH::Numbers->charset("traditional");
+        $_ = number_to_zh($$page{"no"});
+        $$page{"title"} = sprintf __("Legend Volume %s"), $_;
+        $$page{"kw"} = __("legend");
+        $ALT_PAGE_PARAM = {
+            "path"          => $$page{"path"},
+            "lang"          => $lang,
+            "keywords"      => $$page{"kw"},
+            "class"         => "legend",
+            "static"        => 1,
+            "all_linguas"   => [$lang]};
+        $args = page_param;
+        # Set the list parameter
+        $LIST = new Selima::emandy::List::Legend::Public;
+        $LIST->{"view"} = "legend_public";
+        $LIST->{"pageno"} = $$page{"no"};
+        $LIST->{"lastpage"} = ${$pages[$#pages]}{"no"};
+        $LIST->{"total"} = $total;
+        $args = {%$args, %{$LIST->page_param}};
+        # Obtain the page
+        IO::NestedCapture->start(CAPTURE_STDOUT);
+        binmode IO::NestedCapture->instance->{"STDOUT_current"}[-1], ":utf8";
+        html_header $$page{"title"}, $args;
+        $LIST->html($args);
+        html_footer $args;
+        IO::NestedCapture->stop(CAPTURE_STDOUT);
+        $FD = IO::NestedCapture->get_last_out;
+        $html = join "", <$FD>;
+        undef $ALT_PAGE_PARAM;
+        goutpage $html, $$page{"path"}, $lang;
+        
+        # Make the symbolic link for the default language
+        if (defined $Config{"d_symlink"}) {
+            my ($targfile, $linkfile);
+            $_ = $$page{"path"};
+            $_ .= "index.html" if /\/$/;
+            $targfile = basename($_ . ".xhtml");
+            $linkfile = "$DOC_ROOT$_.html";
+            unless (-l $linkfile && readlink $linkfile eq $targfile) {
+                unlink $linkfile if -l $linkfile;
+                symlink $targfile, $linkfile;
+            }
+        }
+    }
+    
+    # Make the symbolic link for the latest page
+    if (defined $Config{"d_symlink"}) {
+        my ($targfile, $linkfile);
+        if (@pages > 0) {
+            $targfile = sprintf "%04d.html.xhtml",
+                ${$pages[$#pages]}{"no"};
+        } else {
+            $targfile = "index.html.xhtml";
+        }
+        $linkfile = "$DOC_ROOT/legend/latest.html.xhtml";
+        unless (-l $linkfile && readlink $linkfile eq $targfile) {
+            unlink $linkfile if -l $linkfile;
+            symlink $targfile, $linkfile;
+        }
+        $targfile = "latest.html.xhtml";
+        $linkfile = "$DOC_ROOT/legend/latest.html.html";
+        unless (-l $linkfile && readlink $linkfile eq $targfile) {
+            unlink $linkfile if -l $linkfile;
+            symlink $targfile, $linkfile;
+        }
+    }
+    
+    # Build the root index page
+    $ALT_PAGE_PARAM = {
+        "path"          => "/legend/",
+        "lang"          => $lang,
+        "keywords"      => __("legend"),
+        "class"         => "legend",
+        "static"        => 1,
+        "all_linguas"   => [$lang],
+        "toc"           => ".."};
+    if (@pages > 0) {
+        $$ALT_PAGE_PARAM{"first"} = "0001.html";
+        $$ALT_PAGE_PARAM{"last"} = "latest.html";
+        ${$pages[$#pages]}{"path"} = "/legend/latest.html";
+    }
+    $args = page_param;
+    # Obtain the page
+    IO::NestedCapture->start(CAPTURE_STDOUT);
+    binmode IO::NestedCapture->instance->{"STDOUT_current"}[-1], ":utf8";
+    html_header __("Legend"), $args;
+    html_legend_index @pages, $args;
+    html_footer $args;
+    IO::NestedCapture->stop(CAPTURE_STDOUT);
+    $FD = IO::NestedCapture->get_last_out;
+    $html = join "", <$FD>;
+    undef $ALT_PAGE_PARAM;
+    goutpage $html, "/legend/", $lang;
+    
+    # Make the symbolic link for the default language
+    if (defined $Config{"d_symlink"}) {
+        my ($targfile, $linkfile);
+        $_ = "/legend/index.html";
+        $targfile = basename($_ . ".xhtml");
+        $linkfile = "$DOC_ROOT$_.html";
+        unless (-l $linkfile && readlink $linkfile eq $targfile) {
+            unlink $linkfile if -l $linkfile;
+            symlink $targfile, $linkfile;
+        }
+    }
+    
+    return;
+}
+
+# compose_page: Compose a page
+sub compose_page($;$) {
+    local ($_, %_);
+    my ($page, $lang, $args, $FD);
+    ($page, $lang) = @_;
+    $lang = getlang if !defined $lang;
+    
+    $ALT_PAGE_PARAM = {
+        "path"          => $$page{"path"},
+        "lang"          => $lang,
+        "keywords"      => $$page{"kw"},
+        "static"        => 1,
+        "all_linguas"   => [$lang]};
+    $$ALT_PAGE_PARAM{"preview"} = $page
+        if exists $$page{"preview"};
+    if (exists $$page{"class"} && defined $$page{"class"} && $$page{"class"} ne "") {
+        $$ALT_PAGE_PARAM{"class"} = $$page{"class"};
+    } elsif ($$page{"path"} =~ /^\/links\//) {
+        $$ALT_PAGE_PARAM{"class"} = "links";
+    }
+    $args = page_param;
+    
+    # Obtain the page
+    IO::NestedCapture->start(CAPTURE_STDOUT);
+    binmode IO::NestedCapture->instance->{"STDOUT_current"}[-1], ":utf8";
+    html_header $$page{"title"}, $args;
+    if ($$page{"path"} =~ /^\/links\/$/) {
+        #html_links_index $page, $args;
+    } elsif ($$page{"path"} =~ /^\/links\/.+$/) {
+        html_links $page, $args;
+    } else {
+        html_body $page, $args;
+    }
+    html_footer $args;
+    IO::NestedCapture->stop(CAPTURE_STDOUT);
+    $FD = IO::NestedCapture->get_last_out;
+    $_ = join "", <$FD>;
+    
+    undef $ALT_PAGE_PARAM;
+    return $_;
+}
+
+return 1;