Initial commit.
This commit is contained in:
55
htdocs/emily/magicat/lib/perl5/Selima/emily.pm
Normal file
55
htdocs/emily/magicat/lib/perl5/Selima/emily.pm
Normal file
@@ -0,0 +1,55 @@
|
||||
# Emily Wu's Website
|
||||
# emily.pm: Emily Wu's Website
|
||||
|
||||
# Copyright (c) 2003-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: 2003-04-06
|
||||
|
||||
package Selima::emily;
|
||||
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::emily::Config;
|
||||
push @EXPORT, @Selima::emily::Config::EXPORT;
|
||||
use Selima::emily::HTML;
|
||||
push @EXPORT, @Selima::emily::HTML::EXPORT;
|
||||
use Selima::emily::Rebuild;
|
||||
push @EXPORT, @Selima::emily::Rebuild::EXPORT;
|
||||
|
||||
# Import our site-specific classess
|
||||
use Selima::emily::Checker::Guestbook;
|
||||
use Selima::emily::Checker::Guestbook::Public;
|
||||
use Selima::emily::Form::Guestbook;
|
||||
use Selima::emily::Form::Guestbook::Public;
|
||||
use Selima::emily::L10N;
|
||||
use Selima::emily::List::Guestbook;
|
||||
use Selima::emily::List::Guestbook::Public;
|
||||
use Selima::emily::List::Search;
|
||||
use Selima::emily::List::Funds;
|
||||
use Selima::emily::Processor::Guestbook::Public;
|
||||
|
||||
# Import our common modules
|
||||
use Selima;
|
||||
push @EXPORT, @Selima::EXPORT;
|
||||
|
||||
@EXPORT_OK = @EXPORT;
|
||||
|
||||
return 1;
|
||||
@@ -0,0 +1,48 @@
|
||||
# Emily Wu's Website
|
||||
# Guestbook.pm: The administrative guestbook form checker.
|
||||
|
||||
# Copyright (c) 2004-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2004-10-24
|
||||
|
||||
package Selima::emily::Checker::Guestbook;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Checker::Guestbook);
|
||||
|
||||
use Selima::ShortCut;
|
||||
|
||||
# _check_identity: Check the identity
|
||||
sub _check_identity : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $error);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
# Check if it exists
|
||||
$error = $self->_missing("identity");
|
||||
return $error if defined $error;
|
||||
# Regularize it
|
||||
$self->_trim("identity");
|
||||
# Check the length
|
||||
return {"msg"=>N_("This occupation is too long. (Max. length [#,_1])"),
|
||||
"margs"=>[${$self->{"maxlens"}}{"identity"}]}
|
||||
if length $form->param("identity") > ${$self->{"maxlens"}}{"identity"};
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
return 1;
|
||||
@@ -0,0 +1,57 @@
|
||||
# Emily Wu's Website
|
||||
# Public.pm: The guestbook form checker.
|
||||
|
||||
# Copyright (c) 2004-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2004-10-24
|
||||
|
||||
package Selima::emily::Checker::Guestbook::Public;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Checker::Guestbook::Public);
|
||||
|
||||
use Selima::DataVars qw($DBH);
|
||||
use Selima::HTTP;
|
||||
use Selima::Logging;
|
||||
use Selima::ShortCut;
|
||||
|
||||
# _check_name: Check the name
|
||||
sub _check_name : method {
|
||||
# Run the parent checker
|
||||
return $_[0]->SUPER::_check_name_req;
|
||||
}
|
||||
|
||||
# _check_identity: Check the identity
|
||||
sub _check_identity : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $error);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
# Check if it exists
|
||||
$error = $self->_missing("identity");
|
||||
return $error if defined $error;
|
||||
# Regularize it
|
||||
$self->_trim("identity");
|
||||
# Check the length
|
||||
return {"msg"=>N_("Your occupation is too long. (Max. length [#,_1])"),
|
||||
"margs"=>[${$self->{"maxlens"}}{"identity"}]}
|
||||
if length $form->param("identity") > ${$self->{"maxlens"}}{"identity"};
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
return 1;
|
||||
83
htdocs/emily/magicat/lib/perl5/Selima/emily/Config.pm
Normal file
83
htdocs/emily/magicat/lib/perl5/Selima/emily/Config.pm
Normal file
@@ -0,0 +1,83 @@
|
||||
# Emily Wu's Website
|
||||
# Config.pm: The web site configuration.
|
||||
|
||||
# Copyright (c) 2003-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: 2003-04-06
|
||||
|
||||
package Selima::emily::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;
|
||||
|
||||
# siteconf: Subroutine to initialize site configuration
|
||||
sub siteconf() {
|
||||
local ($_, %_);
|
||||
|
||||
# The package name and the package title
|
||||
$PACKAGE = "emily";
|
||||
$SITENAME_ABBR = "Emily";
|
||||
# The author and the copyright
|
||||
$AUTHOR = "依瑪貓";
|
||||
$COPYRIGHT = "© <!--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);
|
||||
|
||||
# The languages
|
||||
$DEFAULT_LANG = "zh-tw";
|
||||
@ALL_LINGUAS = qw(zh-tw);
|
||||
|
||||
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" => "2000(?:-\\d{4})?",
|
||||
"content" => copyyear(2000),
|
||||
},
|
||||
"generator" => {
|
||||
"pattern" => "Selima \\d+\\.\\d+",
|
||||
"content" => "Selima $Selima::VERSION",
|
||||
},
|
||||
};
|
||||
}
|
||||
|
||||
no utf8;
|
||||
return 1;
|
||||
@@ -0,0 +1,40 @@
|
||||
# Emily Wu's Website
|
||||
# Guestbook.pm: The administrative guestbook form.
|
||||
|
||||
# Copyright (c) 2004-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2004-10-24
|
||||
|
||||
package Selima::emily::Form::Guestbook;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Form::Guestbook);
|
||||
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
|
||||
# _html_col_identity: The identity
|
||||
sub _html_col_identity : method {
|
||||
$_[0]->_html_coltmpl_text("identity", h_abbr(__("Occupation:")));
|
||||
}
|
||||
|
||||
# _html_col_url: The website URL
|
||||
sub _html_col_url : method {
|
||||
$_[0]->_html_coltmpl_url("url", h_abbr(__("Website URL.:")));
|
||||
}
|
||||
|
||||
return 1;
|
||||
@@ -0,0 +1,78 @@
|
||||
# Emily Wu's Website
|
||||
# Public.pm: The guestbook form.
|
||||
|
||||
# Copyright (c) 2004-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2004-10-24
|
||||
|
||||
package Selima::emily::Form::Guestbook::Public;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Form::Guestbook::Public);
|
||||
|
||||
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{"prefmsg"} = [] if !exists $$args{"prefmsg"};
|
||||
push @{$$args{"prefmsg"}}, __("General commercial advertisements are not welcomed. They may be deleted without notice. HTML is not supported.");
|
||||
$self = $class->SUPER::new($status, $args);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _html_col_email: The e-mail
|
||||
sub _html_col_email : method {
|
||||
$_[0]->_html_coltmpl_text("email", h_abbr(__("E-mail")));
|
||||
}
|
||||
|
||||
# _html_col_identity: The identity
|
||||
sub _html_col_identity : method {
|
||||
$_[0]->_html_coltmpl_text("identity", h_abbr(__("Occupation")));
|
||||
}
|
||||
|
||||
# _html_col_location: The location
|
||||
sub _html_col_location : method {
|
||||
$_[0]->_html_coltmpl_text("location", h_abbr(__("Location")));
|
||||
}
|
||||
|
||||
# _html_col_message: The message
|
||||
sub _html_col_message : method {
|
||||
$_[0]->_html_coltmpl_textarea("message", h_abbr(__("Message")),
|
||||
h_abbr(__("Fill in your message here.")));
|
||||
}
|
||||
|
||||
# _html_col_name: The name
|
||||
sub _html_col_name : method {
|
||||
$_[0]->_html_coltmpl_text("name", h_abbr(__("Signature")));
|
||||
}
|
||||
|
||||
# _html_col_url: The website URL
|
||||
sub _html_col_url : method {
|
||||
$_[0]->_html_coltmpl_url("url", h_abbr(__("Website URL.")));
|
||||
}
|
||||
|
||||
return 1;
|
||||
690
htdocs/emily/magicat/lib/perl5/Selima/emily/HTML.pm
Normal file
690
htdocs/emily/magicat/lib/perl5/Selima/emily/HTML.pm
Normal file
@@ -0,0 +1,690 @@
|
||||
# Emily Wu's Website
|
||||
# HTML.pm: The HTML web page parts.
|
||||
|
||||
# Copyright (c) 2003-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: 2003-04-06
|
||||
|
||||
package Selima::emily::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 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_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 Selima::A2HTML;
|
||||
use Selima::AddGet;
|
||||
use Selima::AltLang;
|
||||
use Selima::DataVars qw(:author :env :input :list :lninfo :requri :siteconf);
|
||||
use Selima::ErrMsg;
|
||||
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_("Guestbook"),
|
||||
"path" => "/magicat/cgi-bin/guestbook.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_("Miscellaneous"),
|
||||
"sub" => [
|
||||
# { "title" => N_("Funds"),
|
||||
# "path" => "/magicat/cgi-bin/funds.cgi" },
|
||||
{ "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 "©".
|
||||
$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"}): h("/copying.html");
|
||||
# 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:emily6wu\@ms27.hinet.net\" />\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 xml:lang=\"en\">$title</span>": $title;
|
||||
if (defined $$link{"title_2ln"}) {
|
||||
$_ = h($$link{"title_2ln"});
|
||||
$_ = "<span 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";
|
||||
<div class="body">
|
||||
|
||||
<ul class="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>
|
||||
|
||||
</div>
|
||||
|
||||
|
||||
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;
|
||||
38
htdocs/emily/magicat/lib/perl5/Selima/emily/L10N.pm
Normal file
38
htdocs/emily/magicat/lib/perl5/Selima/emily/L10N.pm
Normal file
@@ -0,0 +1,38 @@
|
||||
# Emily Wu's Website
|
||||
# L10N.pm: The localization class.
|
||||
|
||||
# Copyright (c) 2003-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: 2003-04-26
|
||||
|
||||
package Selima::emily::L10N;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Locale::Maketext::Gettext);
|
||||
|
||||
return 1;
|
||||
|
||||
# The Chinese (Taiwan) localized messages.
|
||||
package Selima::emily::L10N::zh_tw;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Locale::Maketext::Gettext);
|
||||
|
||||
sub numerate : method { $_[2] }
|
||||
|
||||
return 1;
|
||||
269
htdocs/emily/magicat/lib/perl5/Selima/emily/List/Funds.pm
Normal file
269
htdocs/emily/magicat/lib/perl5/Selima/emily/List/Funds.pm
Normal file
@@ -0,0 +1,269 @@
|
||||
# Emily Wu's Website
|
||||
# Funds.pm: The fund performance 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-12-30
|
||||
|
||||
package Selima::emily::List::Funds;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List);
|
||||
|
||||
use Selima::CommText;
|
||||
use Selima::DataVars qw(:input :requri);
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
|
||||
use Selima::Format;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "funds" if !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = __("Browse Mutual Fund Performances");
|
||||
# The default sort order
|
||||
$self->{"DEFAULT_SORTBY"} = "majcat,mincat,title";
|
||||
# Known columns that should not be displayed (has a special purpose)
|
||||
push @{$self->{"COLS_NO_DISPLAY"}}, qw(_m1rank _m3rank _m6rank
|
||||
_y1rank _y2rank _y3rank _y5rank _y10rank _ytrank);
|
||||
# No selection
|
||||
$self->{"noselect"} = 1;
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"title" => __("Name"),
|
||||
"m1ret" => __("1m return"),
|
||||
"m1rank" => __("1m ranking"),
|
||||
"m3ret" => __("3m return"),
|
||||
"m3rank" => __("3m ranking"),
|
||||
"m6ret" => __("6m return"),
|
||||
"m6rank" => __("6m ranking"),
|
||||
"y1ret" => __("1y return"),
|
||||
"y1rank" => __("1y ranking"),
|
||||
"y2ret" => __("2y return"),
|
||||
"y2rank" => __("2y ranking"),
|
||||
"y3ret" => __("3y return"),
|
||||
"y3rank" => __("3y ranking"),
|
||||
"y5ret" => __("5y return"),
|
||||
"y5rank" => __("5y ranking"),
|
||||
"y10ret" => __("10y return"),
|
||||
"y10rank" => __("10y ranking"),
|
||||
"ytret" => __("This year return"),
|
||||
"ytrank" => __("This year ranking"),
|
||||
"beginret" => __("Total return"),
|
||||
"begindate" => __("Begin from"),
|
||||
"bestm3" => __("Best 3m return"),
|
||||
"worstm3" => __("Worst 3m return"),
|
||||
"sd12" => __("Standard deviation (12m)"),
|
||||
"sd24" => __("Standard deviation (24m)"),
|
||||
"beta12" => __("Beta (12m)"),
|
||||
"beta24" => __("Beta (24m)"),
|
||||
"sharpe12" => __("Sharpe (12m)"),
|
||||
"sharpe24" => __("Sharpe (24m)"),
|
||||
"jensen12" => __("Jensen (12m)"),
|
||||
"jensen24" => __("Jensen (24m)"),
|
||||
"treynor12" => __("Treynor (12m)"),
|
||||
"treynor24" => __("Treynor (24m)"),
|
||||
"infrma12" => __("Information Ratio (major categories) (12m)"),
|
||||
"infrma24" => __("Information Ratio (major categories) (24m)"),
|
||||
"infrmi12" => __("Information Ratio (minor categories) (12m)"),
|
||||
"infrmi24" => __("Information Ratio (minor categories) (24m)"),
|
||||
"turnmt" => __("This month turnover"),
|
||||
"turny1" => __("12m turnover"),
|
||||
"duration" => __("Duration"),
|
||||
"rating" => __("Rating"),
|
||||
"newman" => __("Manager less than 1y?"),
|
||||
);
|
||||
# The pre-defined filter
|
||||
$self->{"pre_filter"} = [
|
||||
["y5ret IS NOT NULL AND y5ret > 150 AND m1rank < 1.0/4 AND m3rank < 1.0/4 AND m6rank < 1.0/4 AND y1rank < 1.0/4 AND y2rank < 1.0/4 AND y3rank < 1.0/4 AND y5rank < 1.0/4"],
|
||||
["y2ret IS NOT NULL AND y1rank < 1.0/4 AND y2rank < 1.0/4 AND m3rank < 1.0/3 AND m6rank < 1.0/3", __("4433 Principle")],
|
||||
];
|
||||
return $self;
|
||||
}
|
||||
|
||||
# pre_filter: Set the pre-defined filter
|
||||
sub pre_filter : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
if (!defined $GET->param("filter") || $GET->param("filter") eq "none") {
|
||||
return undef;
|
||||
} elsif ($GET->param("filter") eq "free") {
|
||||
return $GET->param("filtertext") eq ""? undef:
|
||||
$GET->param("filtertext");
|
||||
} elsif ($GET->param("filter") =~ /^\d+$/) {
|
||||
return $GET->param("filter") <= @{$self->{"pre_filter"}}?
|
||||
${${$self->{"pre_filter"}}[$GET->param("filter") - 1]}[0]: undef;
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
# sql_filter: Get the SQL WHERE phase
|
||||
# A filter to update the *rank to _*rank
|
||||
sub sql_filter : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
$_ = $self->SUPER::sql_filter;
|
||||
s/(?<!_)([my][\dt]+rank)/_$1/g;
|
||||
return $_;
|
||||
}
|
||||
|
||||
# sql_orderby: Get the SQL ORDER BY phase
|
||||
# A filter to update the *rank to _*rank
|
||||
sub sql_orderby : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
$_ = $self->SUPER::sql_orderby;
|
||||
s/(?<!_)([my][\dt]+rank)/_$1/g;
|
||||
return $_;
|
||||
}
|
||||
|
||||
# colval: Output a list column value
|
||||
sub colval : method {
|
||||
local ($_, %_);
|
||||
my ($self, $col, %row);
|
||||
($self, $col, %row) = @_;
|
||||
|
||||
# Null/no value
|
||||
return h(t_none()) if !defined $row{$col};
|
||||
|
||||
# Show as date
|
||||
return h(fmtdate($row{$col})) if $col eq "begindate";
|
||||
|
||||
# Run the parent method
|
||||
return $self->SUPER::colval($col, %row);
|
||||
}
|
||||
|
||||
# html_search: Display the search box
|
||||
sub html_search : method {
|
||||
local ($_, %_);
|
||||
my ($self, $prompt, $label, $query, $request_file);
|
||||
($self, $prompt) = @_;
|
||||
$prompt = __("Search for a fund:") if !defined $prompt;
|
||||
# No search box is displayed if no records yet
|
||||
if ( $self->{"fetched"}
|
||||
&& defined $self->{"total"} && $self->{"total"} == 0
|
||||
&& !defined $self->{"query"}) {
|
||||
return;
|
||||
}
|
||||
|
||||
$request_file = h($REQUEST_FILE);
|
||||
$query = defined $self->{"query"}? h($self->{"query"}): "";
|
||||
$label = h(__("Search"));
|
||||
|
||||
print << "EOT";
|
||||
<form action="$request_file" method="get" accept-charset="<!--selima:charset-->">
|
||||
<div class="searchbox">
|
||||
EOT
|
||||
# Embed the caller information
|
||||
if ($self->{"is_called_form"}) {
|
||||
my ($caller, $cformid);
|
||||
$caller = h($self->{"caller"});
|
||||
$cformid = h($self->{"cformid"});
|
||||
print << "EOT";
|
||||
<input type="hidden" name="caller" value="$caller" />
|
||||
<input type="hidden" name="cformid" value="$cformid" />
|
||||
EOT
|
||||
}
|
||||
if (defined $prompt) {
|
||||
$_ = h($prompt);
|
||||
print << "EOT";
|
||||
<label for="query">$_</label>
|
||||
EOT
|
||||
}
|
||||
print << "EOT";
|
||||
<input id="query" type="text" name="query" value="$query" /><br />
|
||||
EOT
|
||||
# The advanced filter
|
||||
print "<label for=\"filternone\">" . h(__("Advanced filter:")) . "</label>\n";
|
||||
print "<input id=\"filternone\" type=\"radio\" name=\"filter\" value=\"none\""
|
||||
. (!defined $GET->param("filter") || $GET->param("filter") eq "none"?
|
||||
" checked=\"checked\"": "")
|
||||
. " />\n"
|
||||
. "<label for=\"filternone\">" . h_abbr(t_none()) . "</label><br />\n";
|
||||
for (my $i = 0; $i < @{$self->{"pre_filter"}}; $i++) {
|
||||
print "<input id=\"filter" . h($i + 1) . "\" type=\"radio\" name=\"filter\""
|
||||
. " value=\"" . h($i + 1) . "\""
|
||||
. ( defined $GET->param("filter")
|
||||
&& $GET->param("filter") eq $i + 1?
|
||||
" checked=\"checked\"": "")
|
||||
. " />\n"
|
||||
. "<label for=\"filter" . h($i + 1) . "\">"
|
||||
. (@{${$self->{"pre_filter"}}[$i]} > 1?
|
||||
h(sprintf("%s (%s)", ${${$self->{"pre_filter"}}[$i]}[1],
|
||||
${${$self->{"pre_filter"}}[$i]}[0])):
|
||||
h(${${$self->{"pre_filter"}}[$i]}[0]))
|
||||
. "</label><br />\n";
|
||||
}
|
||||
print "<input id=\"filterfree\" type=\"radio\" name=\"filter\" value=\"free\""
|
||||
. (defined $GET->param("filter") && $GET->param("filter") eq "free"?
|
||||
" checked=\"checked\"": "")
|
||||
. " />\n"
|
||||
. "<input id=\"filtertext\" type=\"text\" name=\"filtertext\" size=\"100\""
|
||||
. (defined $GET->param("filtertext")?
|
||||
" value=\"" . h($GET->param("filtertext")) . "\"": "")
|
||||
. " /><br />\n";
|
||||
print << "EOT";
|
||||
<input type="hidden" name="charset" value="<!--selima:charset-->" /><input
|
||||
type="submit" value="$label" />
|
||||
</div>
|
||||
</form>
|
||||
|
||||
EOT
|
||||
}
|
||||
|
||||
# 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,fund].", $self->{"total"});
|
||||
# List result
|
||||
} else {
|
||||
return __("[*,_1,fund].", $self->{"total"});
|
||||
}
|
||||
# More than one page
|
||||
} else {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return __("Your query found [*,_1,fund], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
# List result
|
||||
} else {
|
||||
return __("[*,_1,fund], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
@@ -0,0 +1,47 @@
|
||||
# Emily Wu's Website
|
||||
# Guestbook.pm: The administrative guestbook message list.
|
||||
|
||||
# Copyright (c) 2004-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2004-10-24
|
||||
|
||||
package Selima::emily::List::Guestbook;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List::Guestbook);
|
||||
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "guestbook" if !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = $self->{"is_called_form"}?
|
||||
__("Select a Message"):
|
||||
__("Manage the Guestbook");
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"identity" => __("Occupation"),
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
return 1;
|
||||
@@ -0,0 +1,27 @@
|
||||
# Emily Wu's Website
|
||||
# Public.pm: The guestbook message list.
|
||||
|
||||
# Copyright (c) 2004-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2004-10-24
|
||||
|
||||
package Selima::emily::List::Guestbook::Public;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List::Guestbook::Public);
|
||||
|
||||
return 1;
|
||||
181
htdocs/emily/magicat/lib/perl5/Selima/emily/List/Search.pm
Normal file
181
htdocs/emily/magicat/lib/perl5/Selima/emily/List/Search.pm
Normal file
@@ -0,0 +1,181 @@
|
||||
# Emily 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-04-11
|
||||
|
||||
package Selima::emily::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 "guestbook") {
|
||||
my ($author, $title, $sectitle);
|
||||
$author = defined $$current{"author"}?
|
||||
" <span class=\"note\">" . h($$current{"author"}) . "</span>": "";
|
||||
$title = h(__("Guestbook Message on [_1]", $$current{"date"}));
|
||||
$sectitle = h(__("Guestbook"));
|
||||
|
||||
print << "EOT";
|
||||
<li><h3><a href="$url">$title</a>$author</h3>
|
||||
<address><a href="/cgi-bin/guestbook.cgi">$sectitle</a></address>
|
||||
EOT
|
||||
}
|
||||
print "\n<p>$abstract</p>\n" if defined $abstract;
|
||||
print << "EOT";
|
||||
</li>
|
||||
|
||||
EOT
|
||||
}
|
||||
print << "EOT";
|
||||
</ol>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
return 1;
|
||||
@@ -0,0 +1,142 @@
|
||||
# Emily Wu's Website
|
||||
# Public.pm: The guestbook data processor.
|
||||
|
||||
# Copyright (c) 2006-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-03-19
|
||||
|
||||
package Selima::emily::Processor::Guestbook::Public;
|
||||
use 5.008;
|
||||
use utf8;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Processor::Guestbook);
|
||||
|
||||
use Selima::Country;
|
||||
use Selima::DataVars qw(:env :input :scptconf);
|
||||
use Selima::Format;
|
||||
use Selima::Guest;
|
||||
use Selima::GeoIP;
|
||||
use Selima::RemoHost;
|
||||
use Selima::Unicode;
|
||||
|
||||
# new: Initialize the processor
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[0]->param("form", "new");
|
||||
$_[0]->param("confirm", 1);
|
||||
$self = $class->SUPER::new(@_);
|
||||
$self->{"notify"} = 1;
|
||||
$self->{"debug"} = 1;
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _save_cols: Save the column deposit
|
||||
sub _save_cols : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
($self, @_) = @_;
|
||||
$self->SUPER::_save_cols(@_);
|
||||
$self->{"cols"}->{"login"} = 723676436;
|
||||
return;
|
||||
}
|
||||
|
||||
# _other_tasks: Perform tasks other than column updates
|
||||
sub _other_tasks : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form);
|
||||
my ($mail, $body, $charset);
|
||||
$self = $_[0];
|
||||
return unless $self->{"notify"};
|
||||
$form = $self->{"form"};
|
||||
|
||||
# Compose the mail body
|
||||
$body = "";
|
||||
$body .= "若要編輯或刪除這則留言，請連上以下網址：\n";
|
||||
$body .= "http://" . $ENV{"SERVER_NAME"} . "/magicat/cgi-bin/guestbook.cgi"
|
||||
. "?form=cur&sn=" . $self->{"sn"} . "\n\n";
|
||||
$body .= "日期： " . fmttime . "\n";
|
||||
@_ = qw();
|
||||
push @_, ctname_zhtw country_lookup;
|
||||
push @_, remote_host if defined remote_host;
|
||||
$body .= "來自： " . $ENV{"REMOTE_ADDR"}
|
||||
. " (" . join(", ", @_) . ")\n";
|
||||
$body .= "簽名： " . $form->param("name") . "\n"
|
||||
if $form->param("name") ne "";
|
||||
$body .= "職業： " . $form->param("identity") . "\n"
|
||||
if $form->param("identity") ne "";
|
||||
$body .= "所在地： " . $form->param("location") . "\n"
|
||||
if $form->param("location") ne "";
|
||||
$body .= "E-mail ： " . $form->param("email") . "\n"
|
||||
if $form->param("email") ne "";
|
||||
$body .= "網站網址： " . $form->param("url") . "\n"
|
||||
if $form->param("url") ne "" && $form->param("url") ne "http://";
|
||||
$body .= "留言：\n\n" . $form->param("message") . "\n\n";
|
||||
$body .= "原始內容：\n" . $USER_INPUT{"POST_RAWDATA"} . "\n";
|
||||
|
||||
# Collecting Debugging infomation
|
||||
if ($self->{"debug"}) {
|
||||
$body .= "\n";
|
||||
$body .= "===== Start Debugging Infomation =====\n";
|
||||
if ($IS_MODPERL) {
|
||||
$_ = $IS_MP2? Apache2::RequestUtil->request->as_string:
|
||||
Apache->request->as_string;
|
||||
s/^X-Selima-[^\n]+\n//mg;
|
||||
s/^((?:[^\n]+\n)+).+?$/$1/s;
|
||||
$body .= $_;
|
||||
} else {
|
||||
foreach (sort grep !/^HTTP_X_SELIMA_/, grep /^HTTP_/, keys %ENV) {
|
||||
my $hname;
|
||||
$hname = $_;
|
||||
$hname =~ s/^HTTP_//;
|
||||
$hname =~ s/_/-/g;
|
||||
$hname =~ s/(\w)(\w+)/$1 . lc $2/ge;
|
||||
$body .= "$hname: $ENV{$_}\n";
|
||||
}
|
||||
}
|
||||
$body .= "===== End Debugging Infomation =====\n";
|
||||
}
|
||||
|
||||
# Set the best appropriate output character set
|
||||
$charset = is_charset($body, "Big5")? "Big5": "UTF-8";
|
||||
|
||||
# Compose the mail
|
||||
$mail = new Selima::Mail;
|
||||
$mail->charset($charset);
|
||||
$mail->from($THIS_FILE . "\@" . $ENV{"SERVER_NAME"}, "吳芳美網站留言板");
|
||||
$mail->to("emily6wu\@ms27.hinet.net", "吳芳美");
|
||||
$mail->cc("imacat\@mail.imacat.idv.tw", "楊士青");
|
||||
$mail->subject("[Emily] 留言板留言通知 " . fmtdate);
|
||||
$mail->body($body);
|
||||
# Send it
|
||||
$mail->send;
|
||||
return;
|
||||
}
|
||||
|
||||
# _actlog: Log the activity
|
||||
sub _actlog : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# A form to create a new item
|
||||
return gactlog "Post a new message on " . fmtdate($self->{"date"})
|
||||
. " with s/n " . $self->{"sn"} . ".";
|
||||
}
|
||||
|
||||
no utf8;
|
||||
return 1;
|
||||
283
htdocs/emily/magicat/lib/perl5/Selima/emily/Rebuild.pm
Normal file
283
htdocs/emily/magicat/lib/perl5/Selima/emily/Rebuild.pm
Normal file
@@ -0,0 +1,283 @@
|
||||
# Emily Wu's Website
|
||||
# Rebuild.pm: The subroutines to rebuild the web pages.
|
||||
|
||||
# Copyright (c) 2004-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2004-11-02
|
||||
|
||||
package Selima::emily::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 compose_page);
|
||||
@EXPORT_OK = @EXPORT;
|
||||
# Prototype declaration
|
||||
sub rebuild_all();
|
||||
sub rebuild_pages(;$);
|
||||
sub rebuild_links(;$);
|
||||
sub compose_page($;$);
|
||||
}
|
||||
|
||||
use Data::Dumper qw();
|
||||
use Fcntl qw(:flock);
|
||||
use IO::NestedCapture qw(CAPTURE_STDOUT);
|
||||
|
||||
use Selima::DataVars qw($DBH :output :rebuild);
|
||||
use Selima::GetLang;
|
||||
use Selima::Guest;
|
||||
use Selima::PageFunc;
|
||||
use Selima::ShortCut;
|
||||
|
||||
use Selima::emily::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 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;
|
||||
}
|
||||
|
||||
# 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;
|
||||
Reference in New Issue
Block a user