Initial commit.
This commit is contained in:
34
htdocs/emandy/magicat/biography.html
Normal file
34
htdocs/emandy/magicat/biography.html
Normal file
@@ -0,0 +1,34 @@
|
||||
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
|
||||
"http://www.w3.org/TR/html40/strict.dtd">
|
||||
<html lang="zh-tw">
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=big5">
|
||||
<meta name="author" content="吳燕秋">
|
||||
<meta name="generator" content="UltraEdit-32 8.00a" lang="en">
|
||||
<style type=text/css>
|
||||
h1 {text-align:center}
|
||||
p {text-indent:2em}
|
||||
</style>
|
||||
<title>自傳</title>
|
||||
</head>
|
||||
|
||||
<body>
|
||||
|
||||
<h1>自傳</h1>
|
||||
<p>我在鳳山出生，在六個小孩中排行第五，每逢過年瞧見多子多孫多福氣的春聯，總是分外親切。父母都沒受過什麼教育，又忙營生，向來沒什麼空閒帶我們這些小孩。相較其他同學，我並沒有承受太多父母期望的壓力，倒是因此度過了一個快樂的童年，也培養出獨立自主的生活方式。</p>
|
||||
|
||||
<p>為了滿足長久以來對歷史知識的渴望，我選擇在大學、研究所專攻歷史。課餘閒暇，我參加了不少社團，也喜歡到圖書館將一堆一堆的中外文學作品搬回住處，品味其中的雋永之處。剛開始最吸引我的是新地出版的一系列大陸傷痕文學著作，繼之我回溯30年代小說，蕭紅的《呼蘭河傳》、老舍的<月牙兒>，更早的魯迅《阿Q正傳》、《魯迅全集》等。</p>
|
||||
|
||||
<p>當時適逢國內解嚴，這些文學作品對我的社會意識有極大的啟發，進而參與學運、社運、婦運，接觸議題涵括弱勢族群權益、勞資爭議、環保、婦女權益等層面。本人的碩士論文題目為〈從政治參與看德國婦女運動(1891-1918)〉，算是個人能力所及的一項婦運實踐。</p>
|
||||
|
||||
<p>攻讀碩士學位期間，我在中國社會文化研究中心兼職，算是較接近學術研究方面的工作，這項工作主要在於閱讀中、港、台三地的報紙期刊資料之後，加以分類、編碼、歸檔。</p>
|
||||
|
||||
<p>畢業之後，我擔任台大婦女研究室的助理研究員，主要工作內容為國科會兩性教育通識教育的研究，並分擔研究室行政事務。同時，亦任教於國立空中大學及中國海專，授課內容廣涉臺灣開發史、中國文化史、隋唐史、中國現代史等課程；工作之餘並與以往同儕舉行定期的讀書研討會，發行刊物，俾益所學。</p>
|
||||
|
||||
<p>去年9月與台大婦女研究室為期一年的約聘期滿，之後轉任清華大學歷史研究所傅大為教授的國科會計畫【當代台灣人文網際網路--醫療與身體：網路建構及對20世紀台灣「現代性」之反省】研究助理（1999年10月-2000年9月底）。工作內容為搜集網站、分類，及一些計畫相關的行政業務等。期間亦兼任中研院〈科學史通訊〉執行編輯。</p>
|
||||
|
||||
<p>在電腦的運用上，除了基本的文書資料處理外，如何迅速、有效地利用網路資源，是目前自我進修的一項基礎規劃。網路工具普及化，但是否真能為人們所駕馭，至今尚無定論。當下台灣社運低迷，在具體的動員上都無法與前幾年相提並論，不少社運組織紛紛轉向網路發展，寄望透過電子報及網站等途徑，尋求另一種組織群眾的可能性。我也做了這樣的嘗試，因此與朋友合辦「女聲」電子報，不定期出刊，並設有女聲網站；現亦兼任蕃薯藤女性入口網站hercafe的「女話」專欄作家。因為不願離學術太遠，仍與研究所時的三五好友，創辦〈歷史：理論與文化〉西洋史通訊，並擔任網站的webmaster。</p>
|
||||
|
||||
<p>至於未來規畫，我想繼續攻讀博士班從事學術研究，著手纂寫台灣婦女墮胎文化史。因此對求職的考量，我仍希望留在與學術研究的環境中，在累積這兩年來的工作經驗後，相信在推動行政業務時應該會更加得心應手。此外，我亦深盼能夠藉由這個工作機會，吸收更豐富的學術新知，增廣日後的研究視野。</p>
|
||||
</body>
|
||||
</html>
|
||||
32
htdocs/emandy/magicat/biography1.html
Normal file
32
htdocs/emandy/magicat/biography1.html
Normal file
@@ -0,0 +1,32 @@
|
||||
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
|
||||
"http://www.w3.org/TR/html40/strict.dtd">
|
||||
<html lang="zh-tw">
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=big5">
|
||||
<meta name="author" content="吳燕秋">
|
||||
<meta name="generator" content="UltraEdit-32 8.00a" lang="en">
|
||||
<style type=text/css>
|
||||
h1 {text-align:center}
|
||||
p {text-indent:2em}
|
||||
</style>
|
||||
<title>自傳</title>
|
||||
</head>
|
||||
|
||||
<body>
|
||||
|
||||
<h1>自傳</h1>
|
||||
<p>我在鳳山出生，在六個小孩中排行第五，每逢過年瞧見多子多孫多福氣的春聯，總是分外親切。父母都沒受過什麼教育，又忙營生，向來沒什麼空閒帶我們這些小孩。相較其他同學，我並沒有承受太多父母期望的壓力，倒是因此度過了一個快樂的童年，也培養出獨立自主的生活方式。</p>
|
||||
|
||||
<p>為了滿足長久以來對歷史知識的渴望，我選擇在大學、研究所專攻歷史。課餘閒暇，我參加了不少社團，也喜歡到圖書館將一堆一堆的中外文學作品搬回住處，品味其中的雋永之處。剛開始最吸引我的是新地出版的一系列大陸傷痕文學著作，繼之我回溯30年代小說，蕭紅的《呼蘭河傳》、老舍的<月牙兒>，更早的魯迅《阿Q正傳》、《魯迅全集》等。</p>
|
||||
|
||||
<p>攻讀碩士學位期間，我在中國社會文化研究中心兼職，算是較接近學術研究方面的工作，這項工作主要在於閱讀中、港、台三地的報紙期刊資料之後，加以分類、編碼、歸檔。</p>
|
||||
|
||||
<p>畢業之後，我擔任台大婦女研究室的助理研究員，主要工作內容為國科會兩性教育通識教育的研究，並分擔研究室行政事務。同時，亦任教於國立空中大學及中國海專，授課內容廣涉臺灣開發史、中國文化史、隋唐史、中國現代史等課程；工作之餘並與以往同儕舉行定期的讀書研討會，發行刊物，俾益所學。</p>
|
||||
|
||||
<p>去年9月與台大婦女研究室為期一年的約聘期滿，之後轉任清華大學歷史研究所傅大為教授的國科會計畫【當代台灣人文網際網路--醫療與身體：網路建構及對20世紀台灣「現代性」之反省】研究助理（1999年10月-2000年9月底）。工作內容為搜集網站、分類，及一些計畫相關的行政業務等。期間亦兼任中研院〈科學史通訊〉執行編輯。</p>
|
||||
|
||||
<p>在電腦的運用上，除了基本的文書資料處理外，如何迅速、有效地利用網路資源，是目前自我進修的一項基礎規劃。網路工具普及化，但是否真能為人們所駕馭，至今尚無定論。當下台灣社運低迷，在具體的動員上都無法與前幾年相提並論，不少社運組織紛紛轉向網路發展，寄望透過電子報及網站等途徑，尋求另一種組織群眾的可能性。我也做了這樣的嘗試，因此與朋友合辦「女聲」電子報，不定期出刊，並設有女聲網站；現亦兼任蕃薯藤女性入口網站hercafe的「女話」專欄作家。因不願離學術太遠，仍與研究所時的三五好友，創辦〈歷史：理論與文化〉西洋史通訊，並擔任該網站的webmaster。</p>
|
||||
|
||||
<p>至於未來規畫，我偏好留在學術環境中工作。在累積這兩年來的工作經驗後，相信在推動行政業務時應該會更加得心應手。</p>
|
||||
</body>
|
||||
</html>
|
||||
242
htdocs/emandy/magicat/cgi-bin/acctrecs.cgi
Executable file
242
htdocs/emandy/magicat/cgi-bin/acctrecs.cgi
Executable file
@@ -0,0 +1,242 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Mandy Wu's Website
|
||||
# acctrecs.cgi: The accounting record administration.
|
||||
|
||||
# Copyright (c) 2007-2021 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2007-09-24
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::emandy;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
sub check_get();
|
||||
sub check_post();
|
||||
sub html_page($);
|
||||
sub fetch_curitem();
|
||||
sub import_seltrx($);
|
||||
sub import_selsubj($);
|
||||
|
||||
initenv(-restricted => 1,
|
||||
-this_table => "acctrecs",
|
||||
-dbi_lock => {"acctrecs" => LOCK_EX,
|
||||
"accttrx" => LOCK_SH,
|
||||
"acctsubj" => LOCK_SH},
|
||||
-lastmod => 1,
|
||||
-page_param => {"keywords" => N_("accounting")});
|
||||
|
||||
main;
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
my ($error, $success, $processor);
|
||||
|
||||
# If the request is a GET query
|
||||
if ($ENV{"REQUEST_METHOD"} ne "POST") {
|
||||
$error = check_get;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
html_page $error;
|
||||
|
||||
# Display the page
|
||||
} else {
|
||||
html_page retrieve_status;
|
||||
}
|
||||
|
||||
# If a form was POSTed from the client
|
||||
} else {
|
||||
$error = check_post;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
error_redirect $error;
|
||||
|
||||
# Else, save the data
|
||||
} else {
|
||||
$processor = new Selima::Processor::AcctRec($POST);
|
||||
$success = $processor->process;
|
||||
success_redirect $success;
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# check_get: Check the GET arguments
|
||||
sub check_get() {
|
||||
local ($_, %_);
|
||||
my $error;
|
||||
# Only allowing to run on HTTPS
|
||||
http_403 if !is_https;
|
||||
|
||||
# A form is requested
|
||||
if (is_form) {
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Nothing to check on a new form
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
}
|
||||
# List handler handles its own error
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# check_post: Check the POSTed form
|
||||
sub check_post() {
|
||||
local ($_, %_);
|
||||
my ($checker, $error);
|
||||
# Only allowing to run on HTTPS
|
||||
http_403 if !is_https;
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::AcctRec(curform);
|
||||
$checker->redir(qw(seltrx deltrx selsubj delsubj));
|
||||
$error = $checker->check(qw(trx type ord subj summary amount));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::AcctRec(curform);
|
||||
$checker->redir(qw(del seltrx deltrx selsubj delsubj));
|
||||
$error = $checker->check(qw(trx type ord subj summary amount));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::AcctRec(curform);
|
||||
$checker->redir(qw(cancel));
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# html_page: Display the page
|
||||
sub html_page($) {
|
||||
local ($_, %_);
|
||||
my ($status, $LIST, $FORM);
|
||||
$status = $_[0];
|
||||
# A form is requested
|
||||
if (is_form $status) {
|
||||
$FORM = new Selima::Form::AcctRec($status);
|
||||
html_header $FORM->{"title"};
|
||||
html_errmsg $status;
|
||||
$FORM->html;
|
||||
html_footer;
|
||||
|
||||
# List the available items
|
||||
} else {
|
||||
$LIST = new Selima::List::Accounting::Records;
|
||||
html_header $LIST->{"title"}, $LIST->page_param;
|
||||
html_errmsg $status;
|
||||
$LIST->html;
|
||||
html_footer;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
##################################
|
||||
# Subroutines to manage the data #
|
||||
##################################
|
||||
# fetch_curitem: Fetch the current item
|
||||
sub fetch_curitem() {
|
||||
local ($_, %_);
|
||||
my ($sn, $FORM, $sth, $sql);
|
||||
|
||||
# Return if fetched before
|
||||
return if scalar(keys %CURRENT) > 0;
|
||||
|
||||
# Obtain the current form
|
||||
$FORM = curform;
|
||||
# No item specified
|
||||
return {"msg"=>N_("Please select the accounting record."),
|
||||
"isform"=>0}
|
||||
if !defined $FORM->param("sn");
|
||||
$sn = $FORM->param("sn");
|
||||
|
||||
# Find the record
|
||||
%CURRENT = fetchrec $sn, $THIS_TABLE;
|
||||
# If this record exist
|
||||
return {"msg"=>N_("This accounting record does not exist anymore. Please select another one."),
|
||||
"isform"=>0}
|
||||
if scalar(keys %CURRENT) == 0;
|
||||
|
||||
$CURRENT{"type"} = $CURRENT{"credit"}? "credit": "debit";
|
||||
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# import_seltrx: Import the selected accounting transaction into the retrieved form
|
||||
sub import_seltrx($) {
|
||||
local ($_, %_);
|
||||
my $FORM;
|
||||
$FORM = $_[0];
|
||||
$FORM->param("trx", $GET->param("selsn"))
|
||||
if defined $GET->param("selsn")
|
||||
&& check_sn_in ${$GET->param_fetch("selsn")}[0], "accttrx";
|
||||
return;
|
||||
}
|
||||
|
||||
# import_selsubj: Import the selected accounting subject into the retrieved form
|
||||
sub import_selsubj($) {
|
||||
local ($_, %_);
|
||||
my $FORM;
|
||||
$FORM = $_[0];
|
||||
$FORM->param("subj", $GET->param("selsn"))
|
||||
if defined $GET->param("selsn")
|
||||
&& check_sn_in ${$GET->param_fetch("selsn")}[0], "acctsubj";
|
||||
return;
|
||||
}
|
||||
107
htdocs/emandy/magicat/cgi-bin/acctreps.cgi
Executable file
107
htdocs/emandy/magicat/cgi-bin/acctreps.cgi
Executable file
@@ -0,0 +1,107 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Mandy Wu's Website
|
||||
# acctreps.cgi: The accounting report viewer.
|
||||
|
||||
# Copyright (c) 2007-2021 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2007-09-24
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::emandy;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
sub check_get();
|
||||
sub html_page($);
|
||||
|
||||
initenv(-restricted => 1,
|
||||
-dbi_lock => {"acctsubj" => LOCK_SH,
|
||||
"accttrx" => LOCK_SH,
|
||||
"acctrecs" => LOCK_SH},
|
||||
-lastmod => 1,
|
||||
-page_param => {"keywords" => N_("accounting"),
|
||||
"javascripts" => [qw(/scripts/accounting.js)]});
|
||||
|
||||
main;
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
my $error;
|
||||
# Only allowing requests with GET method
|
||||
# Check it here, since we still want list preference handlers to work
|
||||
http_405 qw(GET) if $ENV{"REQUEST_METHOD"} ne "GET";
|
||||
$error = check_get;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
html_page $error;
|
||||
|
||||
# Display the page
|
||||
} else {
|
||||
html_page retrieve_status;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# check_get: Check the GET arguments
|
||||
sub check_get() {
|
||||
local ($_, %_);
|
||||
# Only allowing to run on HTTPS
|
||||
http_403 if !is_https;
|
||||
# List handler handles its own error
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# html_page: Display the page
|
||||
sub html_page($) {
|
||||
local ($_, %_);
|
||||
my ($status, $LIST, $page_param);
|
||||
$status = $_[0];
|
||||
# List the available items
|
||||
$_ = list_type;
|
||||
if ($_ eq "cashsum") {
|
||||
$LIST = new Selima::List::Accounting::Reports::Cash::Summary;
|
||||
} elsif ($_ eq "ldgr") {
|
||||
$LIST = new Selima::List::Accounting::Reports::Ledger;
|
||||
} elsif ($_ eq "ldgrsum") {
|
||||
$LIST = new Selima::List::Accounting::Reports::Ledger::Summary;
|
||||
} elsif ($_ eq "journal") {
|
||||
$LIST = new Selima::List::Accounting::Reports::Journal;
|
||||
} elsif ($_ eq "tb") {
|
||||
$LIST = new Selima::List::Accounting::Reports::TriBlnc;
|
||||
} elsif ($_ eq "incmstat") {
|
||||
$LIST = new Selima::List::Accounting::Reports::IncmStat;
|
||||
} elsif ($_ eq "blncshet") {
|
||||
$LIST = new Selima::List::Accounting::Reports::BlncShet;
|
||||
} elsif ($_ eq "search") {
|
||||
$LIST = new Selima::List::Accounting::Reports::Search;
|
||||
} else {
|
||||
$LIST = new Selima::List::Accounting::Reports::Cash;
|
||||
}
|
||||
# Return the data as a CSV file
|
||||
return $LIST->html if $LIST->{"iscsv"};
|
||||
# Ordinary list
|
||||
html_header $LIST->{"title"}, $LIST->page_param;
|
||||
html_errmsg $status;
|
||||
$LIST->html;
|
||||
html_footer;
|
||||
return;
|
||||
}
|
||||
292
htdocs/emandy/magicat/cgi-bin/acctsubj.cgi
Executable file
292
htdocs/emandy/magicat/cgi-bin/acctsubj.cgi
Executable file
@@ -0,0 +1,292 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Mandy Wu's Website
|
||||
# acctsubj.cgi: The accounting subject administraion.
|
||||
|
||||
# Copyright (c) 2007-2021 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2007-09-24
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::emandy;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
sub check_get();
|
||||
sub check_post();
|
||||
sub html_page($);
|
||||
sub fetch_curitem();
|
||||
sub import_selparent($);
|
||||
|
||||
initenv(-restricted => 1,
|
||||
-this_table => "acctsubj",
|
||||
-dbi_lock => {"acctsubj" => LOCK_EX,
|
||||
"acctrecs" => LOCK_SH},
|
||||
-lastmod => 1,
|
||||
-page_param => {"keywords" => N_("accounting")});
|
||||
|
||||
main;
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
my ($error, $success, $processor);
|
||||
|
||||
# If the request is a GET query
|
||||
if ($ENV{"REQUEST_METHOD"} ne "POST") {
|
||||
$error = check_get;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
html_page $error;
|
||||
|
||||
# Display the page
|
||||
} else {
|
||||
html_page retrieve_status;
|
||||
}
|
||||
|
||||
# If a form was POSTed from the client
|
||||
} else {
|
||||
$error = check_post;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
error_redirect $error;
|
||||
|
||||
# Else, save the data
|
||||
} else {
|
||||
$processor = new Selima::Processor::AcctSubj($POST);
|
||||
$success = $processor->process;
|
||||
success_redirect $success;
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# check_get: Check the GET arguments
|
||||
sub check_get() {
|
||||
local ($_, %_);
|
||||
my $error;
|
||||
# Only allowing to run on HTTPS
|
||||
http_403 if !is_https;
|
||||
|
||||
# A form is requested
|
||||
if (is_form) {
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Start from the default language
|
||||
return {"msg"=>N_("Please add a new accounting subject from [_1]."),
|
||||
"margs"=>["_DEFAULT_LANG"],
|
||||
"isform"=>0}
|
||||
if getlang ne $DEFAULT_LANG;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
return {"msg"=>N_("This accounting subject has [numerate,_1,an accounting sub-subject,accounting sub-subjects]. It cannot be deleted. To delete the subject, [numerate,_1,its accounting sub-subject,all of its accounting sub-subjects] must first be deleted."),
|
||||
"margs"=>[$CURRENT{"ssubcount"}],
|
||||
"isform"=>0}
|
||||
if $CURRENT{"ssubcount"} > 0;
|
||||
return {"msg"=>N_("This accounting subject has [numerate,_1,an accounting record,accounting records]. It cannot be deleted. To delete the subject, [numerate,_1,its accounting record,all of its accounting records] must first be deleted."),
|
||||
"margs"=>[$CURRENT{"reccount"}],
|
||||
"isform"=>0}
|
||||
if $CURRENT{"reccount"} > 0;
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
}
|
||||
# List handler handles its own error
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# check_post: Check the POSTed form
|
||||
sub check_post() {
|
||||
local ($_, %_);
|
||||
my ($checker, $error);
|
||||
# Only allowing to run on HTTPS
|
||||
http_403 if !is_https;
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Start from the default language
|
||||
return {"msg"=>N_("Please add a new accounting subject from [_1]."),
|
||||
"margs"=>["_DEFAULT_LANG"],
|
||||
"isform"=>0}
|
||||
if getlang ne $DEFAULT_LANG;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::AcctSubj(curform);
|
||||
$checker->redir(qw(selparent delparent));
|
||||
$error = $checker->check(qw(parent code title));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::AcctSubj(curform);
|
||||
$checker->redir(qw(del zhsync selparent delparent));
|
||||
$error = $checker->check(qw(parent code title));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::AcctSubj(curform);
|
||||
$checker->redir(qw(cancel));
|
||||
return {"msg"=>N_("This accounting subject has [numerate,_1,an accounting sub-subject,accounting sub-subjects]. It cannot be deleted. To delete the subject, [numerate,_1,its accounting sub-subject,all of its accounting sub-subjects] must first be deleted."),
|
||||
"margs"=>[$CURRENT{"ssubcount"}],
|
||||
"isform"=>0}
|
||||
if $CURRENT{"ssubcount"} > 0;
|
||||
return {"msg"=>N_("This accounting subject has [numerate,_1,an accounting record,accounting records]. It cannot be deleted. To delete the subject, [numerate,_1,its accounting record,all of its accounting records] must first be deleted."),
|
||||
"margs"=>[$CURRENT{"reccount"}],
|
||||
"isform"=>0}
|
||||
if $CURRENT{"reccount"} > 0;
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# html_page: Display the page
|
||||
sub html_page($) {
|
||||
local ($_, %_);
|
||||
my ($status, $LIST, $FORM);
|
||||
$status = $_[0];
|
||||
# A form is requested
|
||||
if (is_form $status) {
|
||||
$FORM = new Selima::Form::AcctSubj($status);
|
||||
html_header $FORM->{"title"};
|
||||
html_errmsg $status;
|
||||
$FORM->html;
|
||||
html_footer;
|
||||
|
||||
# List the available items
|
||||
} else {
|
||||
if (list_type eq "lastlv") {
|
||||
$LIST = new Selima::List::Accounting::Subjects::LastLv;
|
||||
} else {
|
||||
$LIST = new Selima::List::Accounting::Subjects;
|
||||
}
|
||||
html_header $LIST->{"title"}, $LIST->page_param;
|
||||
html_errmsg $status;
|
||||
$LIST->html;
|
||||
html_footer;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
##################################
|
||||
# Subroutines to manage the data #
|
||||
##################################
|
||||
# fetch_curitem: Fetch the current item
|
||||
sub fetch_curitem() {
|
||||
local ($_, %_);
|
||||
my ($sn, $FORM, $sth, $sql, $row);
|
||||
my ($lang, $lndb, $lndbdef, $title);
|
||||
|
||||
# Return if fetched before
|
||||
return if scalar(keys %CURRENT) > 0;
|
||||
|
||||
# Obtain the current form
|
||||
$FORM = curform;
|
||||
# No item specified
|
||||
return {"msg"=>N_("Please select the accounting subject."),
|
||||
"isform"=>0}
|
||||
if !defined $FORM->param("sn");
|
||||
$sn = $FORM->param("sn");
|
||||
|
||||
# Find the record
|
||||
%CURRENT = fetchrec $sn, $THIS_TABLE;
|
||||
# If this record exist
|
||||
return {"msg"=>N_("This accounting subject does not exist anymore. Please select another one."),
|
||||
"isform"=>0}
|
||||
if scalar(keys %CURRENT) == 0;
|
||||
|
||||
$lang = getlang;
|
||||
$lndb = getlang LN_DATABASE;
|
||||
$lndbdef = ln $DEFAULT_LANG, LN_DATABASE;
|
||||
|
||||
# Obtain the belonging subjects list
|
||||
@_ = qw();
|
||||
push @_, "sn AS sn";
|
||||
if (@ALL_LINGUAS > 1) {
|
||||
$title = $lang eq $DEFAULT_LANG? "title_$lndb":
|
||||
"COALESCE(title_$lndb, title_$lndbdef)";
|
||||
} else {;
|
||||
$title = "title";
|
||||
}
|
||||
push @_, $DBH->strcat("code", "' '", $title) . " AS title";
|
||||
$sql = "SELECT " . join(", ", @_) . " FROM acctsubj"
|
||||
. " WHERE parent=$sn"
|
||||
. " ORDER BY code;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$CURRENT{"ssubcount"} = $sth->rows;
|
||||
for ($_ = 0; $_ < $CURRENT{"ssubcount"}; $_++) {
|
||||
$row = $sth->fetchrow_hashref;
|
||||
$CURRENT{"ssub$_" . "sn"} = $$row{"sn"};
|
||||
$CURRENT{"ssub$_" . "title"} = $$row{"title"};
|
||||
}
|
||||
|
||||
# Obtain the belonging records list
|
||||
$sql = "SELECT sn FROM acctrecs"
|
||||
. " WHERE subj=$sn;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$CURRENT{"reccount"} = $sth->rows;
|
||||
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# import_selparent: Import the selected parent into the retrieved form
|
||||
sub import_selparent($) {
|
||||
local ($_, %_);
|
||||
my $FORM;
|
||||
$FORM = $_[0];
|
||||
if ( defined $GET->param("selsn")
|
||||
&& check_sn_in ${$GET->param_fetch("selsn")}[0], "acctsubj") {
|
||||
$FORM->param("parent", $GET->param("selsn"));
|
||||
$FORM->param("topmost", "false");
|
||||
}
|
||||
return;
|
||||
}
|
||||
278
htdocs/emandy/magicat/cgi-bin/accttrx.cgi
Executable file
278
htdocs/emandy/magicat/cgi-bin/accttrx.cgi
Executable file
@@ -0,0 +1,278 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Mandy Wu's Website
|
||||
# accttrx.cgi: The accounting transaction administraion.
|
||||
|
||||
# Copyright (c) 2007-2021 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2007-09-24
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::emandy;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
sub check_get();
|
||||
sub check_post();
|
||||
sub html_page($);
|
||||
sub fetch_curitem();
|
||||
sub import_selsubj($);
|
||||
|
||||
initenv(-restricted => 1,
|
||||
-this_table => "accttrx",
|
||||
-dbi_lock => {"accttrx" => LOCK_EX,
|
||||
"acctrecs" => LOCK_EX,
|
||||
"acctsubj" => LOCK_SH},
|
||||
-lastmod => 1,
|
||||
-page_param => {"keywords" => N_("accounting"),
|
||||
"javascripts" => [qw(/scripts/accounting.js)]});
|
||||
|
||||
main;
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
my ($error, $success, $processor);
|
||||
|
||||
# If the request is a GET query
|
||||
if ($ENV{"REQUEST_METHOD"} ne "POST") {
|
||||
$error = check_get;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
html_page $error;
|
||||
|
||||
# Display the page
|
||||
} else {
|
||||
html_page retrieve_status;
|
||||
}
|
||||
|
||||
# If a form was POSTed from the client
|
||||
} else {
|
||||
$error = check_post;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
error_redirect $error;
|
||||
|
||||
# Else, save the data
|
||||
} else {
|
||||
$processor = new Selima::Processor::AcctTrx($POST);
|
||||
$success = $processor->process;
|
||||
success_redirect $success;
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# check_get: Check the GET arguments
|
||||
sub check_get() {
|
||||
local ($_, %_);
|
||||
my $error;
|
||||
# Only allowing to run on HTTPS
|
||||
http_403 if !is_https;
|
||||
|
||||
# A form is requested
|
||||
if (is_form) {
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Nothing to check on a new form
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
}
|
||||
# List handler handles its own error
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# check_post: Check the POSTed form
|
||||
sub check_post() {
|
||||
local ($_, %_);
|
||||
my ($checker, $error);
|
||||
# Only allowing to run on HTTPS
|
||||
http_403 if !is_https;
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::AcctTrx(curform);
|
||||
$checker->redir(qw(cnvttrans selsubj));
|
||||
$error = $checker->check(qw(date ord note recs));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::AcctTrx(curform);
|
||||
$checker->redir(qw(del cnvttrans selsubj));
|
||||
$error = $checker->check(qw(date ord note recs));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::AcctTrx(curform);
|
||||
$checker->redir(qw(cancel));
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# html_page: Display the page
|
||||
sub html_page($) {
|
||||
local ($_, %_);
|
||||
my ($status, $LIST, $FORM);
|
||||
$status = $_[0];
|
||||
# A form is requested
|
||||
if (is_form $status) {
|
||||
$FORM = new Selima::Form::AcctTrx($status);
|
||||
html_header $FORM->{"title"};
|
||||
html_errmsg $status;
|
||||
$FORM->html;
|
||||
html_footer;
|
||||
|
||||
# List the available items
|
||||
} else {
|
||||
$LIST = new Selima::List::Accounting::Transacts;
|
||||
html_header $LIST->{"title"}, $LIST->page_param;
|
||||
html_errmsg $status;
|
||||
$LIST->html;
|
||||
html_footer;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
##################################
|
||||
# Subroutines to manage the data #
|
||||
##################################
|
||||
# fetch_curitem: Fetch the current item
|
||||
sub fetch_curitem() {
|
||||
local ($_, %_);
|
||||
my ($sn, $FORM, $sth, $sql, $row);
|
||||
|
||||
# Return if fetched before
|
||||
return if scalar(keys %CURRENT) > 0;
|
||||
|
||||
# Obtain the current form
|
||||
$FORM = curform;
|
||||
# No item specified
|
||||
return {"msg"=>N_("Please select the accounting transaction."),
|
||||
"isform"=>0}
|
||||
if !defined $FORM->param("sn");
|
||||
$sn = $FORM->param("sn");
|
||||
|
||||
# Find the record
|
||||
%CURRENT = fetchrec $sn, $THIS_TABLE;
|
||||
# If this record exist
|
||||
return {"msg"=>N_("This accounting transaction does not exist anymore. Please select another one."),
|
||||
"isform"=>0}
|
||||
if scalar(keys %CURRENT) == 0;
|
||||
|
||||
# Obtain the belonging debit records list
|
||||
$sql = "SELECT * FROM acctrecs"
|
||||
. " WHERE trx=$sn"
|
||||
. " AND NOT credit"
|
||||
. " ORDER BY ord;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$CURRENT{"debtcount"} = $sth->rows;
|
||||
for ($_ = 0; $_ < $CURRENT{"debtcount"}; $_++) {
|
||||
$row = $sth->fetchrow_hashref;
|
||||
$CURRENT{"debt$_" . "sn"} = $$row{"sn"};
|
||||
$CURRENT{"debt$_" . "ord"} = $$row{"ord"};
|
||||
$CURRENT{"debt$_" . "subj"} = $$row{"subj"};
|
||||
$CURRENT{"debt$_" . "summary"} = $$row{"summary"};
|
||||
$CURRENT{"debt$_" . "amount"} = $$row{"amount"};
|
||||
}
|
||||
|
||||
# Obtain the belonging credit records list
|
||||
$sql = "SELECT * FROM acctrecs"
|
||||
. " WHERE trx=$sn"
|
||||
. " AND credit"
|
||||
. " ORDER BY ord;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$CURRENT{"crdtcount"} = $sth->rows;
|
||||
for ($_ = 0; $_ < $CURRENT{"crdtcount"}; $_++) {
|
||||
$row = $sth->fetchrow_hashref;
|
||||
$CURRENT{"crdt$_" . "sn"} = $$row{"sn"};
|
||||
$CURRENT{"crdt$_" . "ord"} = $$row{"ord"};
|
||||
$CURRENT{"crdt$_" . "subj"} = $$row{"subj"};
|
||||
$CURRENT{"crdt$_" . "summary"} = $$row{"summary"};
|
||||
$CURRENT{"crdt$_" . "amount"} = $$row{"amount"};
|
||||
}
|
||||
|
||||
# Determine the subform type
|
||||
if ( $CURRENT{"debtcount"} == 1
|
||||
&& acctsubj_code($CURRENT{"debt0subj"}) eq ACCTSUBJ_CASH
|
||||
&& !defined $CURRENT{"debt0summary"}) {
|
||||
$CURRENT{"formsub"} = "income";
|
||||
} elsif ( $CURRENT{"crdtcount"} == 1
|
||||
&& acctsubj_code($CURRENT{"crdt0subj"}) eq ACCTSUBJ_CASH
|
||||
&& !defined $CURRENT{"crdt0summary"}) {
|
||||
$CURRENT{"formsub"} = "expense";
|
||||
} else {
|
||||
$CURRENT{"formsub"} = "trans";
|
||||
}
|
||||
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# import_selsubj: Import the selected subject into the retrieved form
|
||||
sub import_selsubj($) {
|
||||
my $FORM;
|
||||
$FORM = $_[0];
|
||||
# Sanity checks
|
||||
return $FORM
|
||||
if !defined $GET->param("selsn")
|
||||
|| !check_sn_in ${$GET->param_fetch("selsn")}[0], "acctsubj"
|
||||
|| !defined $FORM->param("caller_index");
|
||||
$FORM->param($FORM->param("caller_index") . "subj", $GET->param("selsn"));
|
||||
return $FORM;
|
||||
}
|
||||
51
htdocs/emandy/magicat/cgi-bin/actlog.cgi
Executable file
51
htdocs/emandy/magicat/cgi-bin/actlog.cgi
Executable file
@@ -0,0 +1,51 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Mandy Wu's Website
|
||||
# actlog.cgi: The activity log viewer.
|
||||
|
||||
# Copyright (c) 2006-2021 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-11-14
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::emandy;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
|
||||
initenv(-restricted => 1,
|
||||
-allowed => [qw(GET HEAD)],
|
||||
-lastmod => 0,
|
||||
-lmfiles => [$ACTLOG],
|
||||
-page_param => {"keywords" => N_("activity, logs")});
|
||||
|
||||
main;
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
my $LIST;
|
||||
# List handler handles its own error
|
||||
$LIST = new Selima::List::ActLog;
|
||||
html_header $LIST->{"title"};
|
||||
html_errmsg retrieve_status;
|
||||
$LIST->html;
|
||||
html_footer;
|
||||
return;
|
||||
}
|
||||
226
htdocs/emandy/magicat/cgi-bin/books.cgi
Executable file
226
htdocs/emandy/magicat/cgi-bin/books.cgi
Executable file
@@ -0,0 +1,226 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Mandy Wu's Website
|
||||
# books.cgi: The book administration.
|
||||
|
||||
# Copyright (c) 2006-2021 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-11-15
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::emandy;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
sub check_get();
|
||||
sub check_post();
|
||||
sub html_page($);
|
||||
sub fetch_curitem();
|
||||
|
||||
initenv(-restricted => 1,
|
||||
-this_table => "books",
|
||||
-dbi_lock => {"books" => LOCK_EX},
|
||||
-lastmod => 1,
|
||||
-page_param => {"keywords" => N_("books")});
|
||||
|
||||
main;
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
my ($error, $success, $processor);
|
||||
|
||||
# If the request is a GET query
|
||||
if ($ENV{"REQUEST_METHOD"} ne "POST") {
|
||||
$error = check_get;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
html_page $error;
|
||||
|
||||
# Display the page
|
||||
} else {
|
||||
html_page retrieve_status;
|
||||
}
|
||||
|
||||
# If a form was POSTed from the client
|
||||
} else {
|
||||
$error = check_post;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
error_redirect $error;
|
||||
|
||||
# Else, save the data
|
||||
} else {
|
||||
$processor = new Selima::emandy::Processor::Book($POST);
|
||||
$success = $processor->process;
|
||||
success_redirect $success;
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# check_get: Check the GET arguments
|
||||
sub check_get() {
|
||||
local ($_, %_);
|
||||
my $error;
|
||||
|
||||
# A form is requested
|
||||
if (is_form) {
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Start from the default language
|
||||
return {"msg"=>N_("Please create a new book from [_1]."),
|
||||
"margs"=>["_DEFAULT_LANG"],
|
||||
"isform"=>0}
|
||||
if getlang ne $DEFAULT_LANG;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
}
|
||||
# List handler handles its own error
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# check_post: Check the POSTed form
|
||||
sub check_post() {
|
||||
local ($_, %_);
|
||||
my ($checker, $error);
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Start from the default language
|
||||
return {"msg"=>N_("Please create a new book from [_1]."),
|
||||
"margs"=>["_DEFAULT_LANG"],
|
||||
"isform"=>0}
|
||||
if getlang ne $DEFAULT_LANG;
|
||||
# Run the checker
|
||||
$checker = new Selima::emandy::Checker::Book(curform);
|
||||
$error = $checker->check(qw(title author year origin pub
|
||||
review comment lib));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
# Run the checker
|
||||
$checker = new Selima::emandy::Checker::Book(curform);
|
||||
$checker->redir(qw(del));
|
||||
$error = $checker->check(qw(title author year origin pub
|
||||
review comment lib));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;;
|
||||
# Run the checker
|
||||
$checker = new Selima::emandy::Checker::Book(curform);
|
||||
$checker->redir(qw(cancel));
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# html_page: Display the page
|
||||
sub html_page($) {
|
||||
local ($_, %_);
|
||||
my ($status, $LIST, $FORM);
|
||||
$status = $_[0];
|
||||
# A form is requested
|
||||
if (is_form $status) {
|
||||
$FORM = new Selima::emandy::Form::Book($status);
|
||||
html_header $FORM->{"title"};
|
||||
html_errmsg $status;
|
||||
$FORM->html;
|
||||
html_footer;
|
||||
|
||||
# List the available items
|
||||
} else {
|
||||
if (list_type eq "toborrow") {
|
||||
$LIST = new Selima::emandy::List::Books::ToBorrow;
|
||||
} elsif (list_type eq "nottoborrow") {
|
||||
$LIST = new Selima::emandy::List::Books::NotToBorrow;
|
||||
} else {
|
||||
$LIST = new Selima::emandy::List::Books;
|
||||
}
|
||||
html_header $LIST->{"title"}, $LIST->page_param;
|
||||
html_errmsg $status;
|
||||
$LIST->html;
|
||||
html_footer;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
##################################
|
||||
# Subroutines to manage the data #
|
||||
##################################
|
||||
# fetch_curitem: Fetch the current item
|
||||
sub fetch_curitem() {
|
||||
local ($_, %_);
|
||||
my ($sn, $FORM);
|
||||
|
||||
# Return if fetched before
|
||||
return if scalar(keys %CURRENT) > 0;
|
||||
|
||||
# Obtain the current form
|
||||
$FORM = curform;
|
||||
# No item specified
|
||||
return {"msg"=>N_("Please select the book."),
|
||||
"isform"=>0}
|
||||
if !defined $FORM->param("sn");
|
||||
$sn = $FORM->param("sn");
|
||||
|
||||
# Find the record
|
||||
%CURRENT = fetchrec $sn, $THIS_TABLE;
|
||||
# If this record exist
|
||||
return {"msg"=>N_("This book does not exist anymore. Please select another one."),
|
||||
"isform"=>0}
|
||||
if scalar(keys %CURRENT) == 0;
|
||||
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
236
htdocs/emandy/magicat/cgi-bin/groupmem.cgi
Executable file
236
htdocs/emandy/magicat/cgi-bin/groupmem.cgi
Executable file
@@ -0,0 +1,236 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Mandy Wu's Website
|
||||
# groupmem.cgi: The group-to-group membership administration.
|
||||
|
||||
# Copyright (c) 2006-2021 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-11-14
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::emandy;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
sub check_get();
|
||||
sub check_post();
|
||||
sub html_page($);
|
||||
sub fetch_curitem();
|
||||
sub import_selgrp($);
|
||||
sub import_selmember($);
|
||||
|
||||
initenv(-restricted => 1,
|
||||
-this_table => "groupmem",
|
||||
-dbi_lock => {"groupmem" => LOCK_EX,
|
||||
"groups" => LOCK_SH,
|
||||
"groups AS grpmembers" => LOCK_SH},
|
||||
-lastmod => 1,
|
||||
-page_param => {"keywords" => N_("group membership")});
|
||||
|
||||
main;
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
my ($error, $success, $processor);
|
||||
|
||||
# If the request is a GET query
|
||||
if ($ENV{"REQUEST_METHOD"} ne "POST") {
|
||||
$error = check_get;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
html_page $error;
|
||||
|
||||
# Display the page
|
||||
} else {
|
||||
html_page retrieve_status;
|
||||
}
|
||||
|
||||
# If a form was POSTed from the client
|
||||
} else {
|
||||
$error = check_post;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
error_redirect $error;
|
||||
|
||||
# Else, save the data
|
||||
} else {
|
||||
$processor = new Selima::Processor::GroupMem($POST);
|
||||
$success = $processor->process;
|
||||
success_redirect $success;
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# check_get: Check the GET arguments
|
||||
sub check_get() {
|
||||
local ($_, %_);
|
||||
my $error;
|
||||
|
||||
# A form is requested
|
||||
if (is_form) {
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Nothing to check on a new form
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
}
|
||||
# List handler handles its own error
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# check_post: Check the POSTed form
|
||||
sub check_post() {
|
||||
local ($_, %_);
|
||||
my ($checker, $error);
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::GroupMem(curform);
|
||||
$checker->redir(qw(selgrp delgrp selmember delmember));
|
||||
$error = $checker->check(qw(grp member));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::GroupMem(curform);
|
||||
$checker->redir(qw(del selgrp delgrp selmember delmember));
|
||||
$error = $checker->check(qw(grp member));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::GroupMem(curform);
|
||||
$checker->redir(qw(cancel));
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# html_page: Display the page
|
||||
sub html_page($) {
|
||||
local ($_, %_);
|
||||
my ($status, $LIST, $FORM);
|
||||
$status = $_[0];
|
||||
# A form is requested
|
||||
if (is_form $status) {
|
||||
$FORM = new Selima::Form::GroupMem($status);
|
||||
html_header $FORM->{"title"};
|
||||
html_errmsg $status;
|
||||
$FORM->html;
|
||||
html_footer;
|
||||
|
||||
# List the available items
|
||||
} else {
|
||||
$LIST = new Selima::List::GroupMem;
|
||||
html_header $LIST->{"title"}, $LIST->page_param;
|
||||
html_errmsg $status;
|
||||
$LIST->html;
|
||||
html_footer;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
##################################
|
||||
# Subroutines to manage the data #
|
||||
##################################
|
||||
# fetch_curitem: Fetch the current item
|
||||
sub fetch_curitem() {
|
||||
local ($_, %_);
|
||||
my ($sn, $FORM);
|
||||
|
||||
# Return if fetched before
|
||||
return if scalar(keys %CURRENT) > 0;
|
||||
|
||||
# Obtain the current form
|
||||
$FORM = curform;
|
||||
# No item specified
|
||||
return {"msg"=>N_("Please select the membership record."),
|
||||
"isform"=>0}
|
||||
if !defined $FORM->param("sn");
|
||||
$sn = $FORM->param("sn");
|
||||
|
||||
# Find the record
|
||||
%CURRENT = fetchrec $sn, $THIS_TABLE;
|
||||
# If this record exist
|
||||
return {"msg"=>N_("This membership record does not exist anymore. Please select another one."),
|
||||
"isform"=>0}
|
||||
if scalar(keys %CURRENT) == 0;
|
||||
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# import_selgrp: Import the selected group into the retrieved form
|
||||
sub import_selgrp($) {
|
||||
local ($_, %_);
|
||||
my $FORM;
|
||||
$FORM = $_[0];
|
||||
$FORM->param("grp", $GET->param("selsn"))
|
||||
if defined $GET->param("selsn")
|
||||
&& check_sn_in ${$GET->param_fetch("selsn")}[0], "groups";
|
||||
return;
|
||||
}
|
||||
|
||||
# import_selmember: Import the selected member into the retrieved form
|
||||
sub import_selmember($) {
|
||||
local ($_, %_);
|
||||
my $FORM;
|
||||
$FORM = $_[0];
|
||||
$FORM->param("member", $GET->param("selsn"))
|
||||
if defined $GET->param("selsn")
|
||||
&& check_sn_in ${$GET->param_fetch("selsn")}[0], "groups AS grpmembers";
|
||||
return $FORM;
|
||||
}
|
||||
357
htdocs/emandy/magicat/cgi-bin/groups.cgi
Executable file
357
htdocs/emandy/magicat/cgi-bin/groups.cgi
Executable file
@@ -0,0 +1,357 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Mandy Wu's Website
|
||||
# groups.cgi: The account group administration.
|
||||
|
||||
# Copyright (c) 2006-2021 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-11-14
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::emandy;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
sub check_get();
|
||||
sub check_post();
|
||||
sub html_page($);
|
||||
sub fetch_curitem();
|
||||
sub import_selsubuser($);
|
||||
sub import_selsubgroup($);
|
||||
sub import_selsupgroup($);
|
||||
|
||||
initenv(-restricted => 1,
|
||||
-this_table => "groups",
|
||||
-dbi_lock => {"groups" => LOCK_EX,
|
||||
"usermem" => LOCK_EX,
|
||||
"groupmem" => LOCK_EX,
|
||||
"users" => LOCK_SH,
|
||||
"users AS members" => LOCK_SH,
|
||||
"groups AS members" => LOCK_SH},
|
||||
-lastmod => 1,
|
||||
-page_param => {"keywords" => N_("groups")});
|
||||
|
||||
main;
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
my ($error, $success, $processor);
|
||||
|
||||
# If the request is a GET query
|
||||
if ($ENV{"REQUEST_METHOD"} ne "POST") {
|
||||
$error = check_get;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
html_page $error;
|
||||
|
||||
# Display the page
|
||||
} else {
|
||||
html_page retrieve_status;
|
||||
}
|
||||
|
||||
# If a form was POSTed from the client
|
||||
} else {
|
||||
$error = check_post;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
error_redirect $error;
|
||||
|
||||
# Else, save the data
|
||||
} else {
|
||||
$processor = new Selima::Processor::Group($POST);
|
||||
$success = $processor->process;
|
||||
success_redirect $success;
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# check_get: Check the GET arguments
|
||||
sub check_get() {
|
||||
local ($_, %_);
|
||||
my ($error, $FORM, $sn);
|
||||
|
||||
# A form is requested
|
||||
if (is_form) {
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Nothing to check on a new form
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check the privilege to manage this table
|
||||
$FORM = curform;
|
||||
$sn = defined $FORM->param("sn")? $FORM->param("sn"): -1;
|
||||
unauth if !is_su && $sn == su_group_sn;
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
}
|
||||
# List handler handles its own error
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# check_post: Check the POSTed form
|
||||
sub check_post() {
|
||||
local ($_, %_);
|
||||
my ($checker, $error, $FORM, $sn);
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::Group(curform);
|
||||
$checker->redir(qw(selsubuser selsubgroup selsupgroup));
|
||||
$error = $checker->check(qw(id dsc subuser subgroup supgroup));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::Group(curform);
|
||||
$checker->redir(qw(del selsubuser selsubgroup selsupgroup));
|
||||
$error = $checker->check(qw(id dsc subuser subgroup supgroup));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check the privilege to manage this table
|
||||
$FORM = curform;
|
||||
$sn = defined $FORM->param("sn")? $FORM->param("sn"): -1;
|
||||
unauth if !is_su && $sn == su_group_sn;
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::Group(curform);
|
||||
$checker->redir(qw(cancel));
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# html_page: Display the page
|
||||
sub html_page($) {
|
||||
local ($_, %_);
|
||||
my ($status, $LIST, $FORM);
|
||||
$status = $_[0];
|
||||
# A form is requested
|
||||
if (is_form $status) {
|
||||
$FORM = new Selima::Form::Group($status);
|
||||
html_header $FORM->{"title"};
|
||||
html_errmsg $status;
|
||||
$FORM->html;
|
||||
html_footer;
|
||||
|
||||
# List the available items
|
||||
} else {
|
||||
$LIST = new Selima::List::Groups;
|
||||
html_header $LIST->{"title"}, $LIST->page_param;
|
||||
html_errmsg $status;
|
||||
$LIST->html;
|
||||
html_footer;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
##################################
|
||||
# Subroutines to manage the data #
|
||||
##################################
|
||||
# fetch_curitem: Fetch the current item
|
||||
sub fetch_curitem() {
|
||||
local ($_, %_);
|
||||
my ($sn, $FORM, $sth, $sql, $row, $title);
|
||||
|
||||
# Return if fetched before
|
||||
return if scalar(keys %CURRENT) > 0;
|
||||
|
||||
# Obtain the current form
|
||||
$FORM = curform;
|
||||
# No item specified
|
||||
return {"msg"=>N_("Please select the group."),
|
||||
"isform"=>0}
|
||||
if !defined $FORM->param("sn");
|
||||
$sn = $FORM->param("sn");
|
||||
|
||||
# Find the record
|
||||
%CURRENT = fetchrec $sn, $THIS_TABLE;
|
||||
# If this record exist
|
||||
return {"msg"=>N_("This group does not exist anymore. Please select another one."),
|
||||
"isform"=>0}
|
||||
if scalar(keys %CURRENT) == 0;
|
||||
|
||||
# Obtain the user members list
|
||||
$title = $DBH->strcat("users.id", "' ('", "users.name", "')'");
|
||||
$sql = "SELECT users.sn AS sn,"
|
||||
. " $title AS title"
|
||||
. " FROM usermem"
|
||||
. " INNER JOIN users ON usermem.member=users.sn"
|
||||
. " WHERE usermem.grp=$sn"
|
||||
. " ORDER BY users.id;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$CURRENT{"subusercount"} = $sth->rows;
|
||||
for ($_ = 0; $_ < $CURRENT{"subusercount"}; $_++) {
|
||||
$row = $sth->fetchrow_hashref;
|
||||
$CURRENT{"subuser$_"} = 1;
|
||||
$CURRENT{"subuser$_" . "sn"} = $$row{"sn"};
|
||||
$CURRENT{"subuser$_" . "title"} = $$row{"title"};
|
||||
}
|
||||
|
||||
# Obtain the group members list
|
||||
$sql = "SELECT groups.sn AS sn,"
|
||||
. " groups.dsc AS title FROM groupmem"
|
||||
. " INNER JOIN groups ON groupmem.member=groups.sn"
|
||||
. " WHERE groupmem.grp=$sn"
|
||||
. " ORDER BY groups.id;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$CURRENT{"subgroupcount"} = $sth->rows;
|
||||
for ($_ = 0; $_ < $CURRENT{"subgroupcount"}; $_++) {
|
||||
$row = $sth->fetchrow_hashref;
|
||||
$CURRENT{"subgroup$_"} = 1;
|
||||
$CURRENT{"subgroup$_" . "sn"} = $$row{"sn"};
|
||||
$CURRENT{"subgroup$_" . "title"} = $$row{"title"};
|
||||
}
|
||||
|
||||
# Obtain the belonging groups list
|
||||
$sql = "SELECT groups.sn AS sn,"
|
||||
. " groups.dsc AS title FROM groupmem"
|
||||
. " INNER JOIN groups ON groupmem.grp=groups.sn"
|
||||
. " WHERE groupmem.member=$sn"
|
||||
. " ORDER BY groups.id;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$CURRENT{"supgroupcount"} = $sth->rows;
|
||||
for ($_ = 0; $_ < $CURRENT{"supgroupcount"}; $_++) {
|
||||
$row = $sth->fetchrow_hashref;
|
||||
$CURRENT{"supgroup$_"} = 1;
|
||||
$CURRENT{"supgroup$_" . "sn"} = $$row{"sn"};
|
||||
$CURRENT{"supgroup$_" . "title"} = $$row{"title"};
|
||||
}
|
||||
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# import_selsubuser: Import the selected user into the retrieved form
|
||||
sub import_selsubuser($) {
|
||||
local ($_, %_);
|
||||
my $FORM;
|
||||
$FORM = $_[0];
|
||||
# Sanity checks
|
||||
if ( defined $GET->param("selsn")
|
||||
&& check_sn_in ${$GET->param_fetch("selsn")}[0], "users AS members") {
|
||||
# Get the current member list
|
||||
%_ = map { $FORM->param($_) => 1 } grep /^subuser\d+sn$/, $FORM->param;
|
||||
$_{$GET->param("selsn")} = 1;
|
||||
@_ = sort { userid $a cmp userid $b } keys %_;
|
||||
# Get the checked member list
|
||||
%_ = map { $FORM->param($_ . "sn") => 1 }
|
||||
grep /^subuser\d+$/ && defined $FORM->param($_ . "sn"), $FORM->param;
|
||||
$_{$GET->param("selsn")} = 1;
|
||||
# Remove the old values
|
||||
$FORM->delete(grep /^subuser\d+/, $FORM->param);
|
||||
# Add the current values
|
||||
for ($_ = 0; $_ < @_; $_++) {
|
||||
$FORM->param("subuser$_" . "sn", $_[$_]);
|
||||
$FORM->param("subuser$_", 1) if exists $_{$_[$_]};
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# import_selsubgroup: Import the selected user into the retrieved form
|
||||
sub import_selsubgroup($) {
|
||||
local ($_, %_);
|
||||
my $FORM;
|
||||
$FORM = $_[0];
|
||||
# Sanity checks
|
||||
if ( defined $GET->param("selsn")
|
||||
&& check_sn_in ${$GET->param_fetch("selsn")}[0], "groups AS members") {
|
||||
# Get the current member list
|
||||
%_ = map { $FORM->param($_) => 1 } grep /^subgroup\d+sn$/, $FORM->param;
|
||||
$_{$GET->param("selsn")} = 1;
|
||||
@_ = sort { groupid $a cmp groupid $b } keys %_;
|
||||
# Get the checked member list
|
||||
%_ = map { $FORM->param($_ . "sn") => 1 }
|
||||
grep /^subgroup\d+$/ && defined $FORM->param($_ . "sn"), $FORM->param;
|
||||
$_{$GET->param("selsn")} = 1;
|
||||
# Remove the old values
|
||||
$FORM->delete(grep /^subgroup\d+/, $FORM->param);
|
||||
# Add the current values
|
||||
for ($_ = 0; $_ < @_; $_++) {
|
||||
$FORM->param("subgroup$_" . "sn", $_[$_]);
|
||||
$FORM->param("subgroup$_", 1) if exists $_{$_[$_]};
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# import_selsupgroup: Import the selected user into the retrieved form
|
||||
sub import_selsupgroup($) {
|
||||
local ($_, %_);
|
||||
my $FORM;
|
||||
$FORM = $_[0];
|
||||
# Sanity checks
|
||||
if ( defined $GET->param("selsn")
|
||||
&& check_sn_in ${$GET->param_fetch("selsn")}[0], "groups") {
|
||||
# Get the current member list
|
||||
%_ = map { $FORM->param($_) => 1 } grep /^supgroup\d+sn$/, $FORM->param;
|
||||
$_{$GET->param("selsn")} = 1;
|
||||
@_ = sort { groupid $a cmp groupid $b } keys %_;
|
||||
# Get the checked member list
|
||||
%_ = map { $FORM->param($_ . "sn") => 1 }
|
||||
grep /^supgroup\d+$/ && defined $FORM->param($_ . "sn"), $FORM->param;
|
||||
$_{$GET->param("selsn")} = 1;
|
||||
# Remove the old values
|
||||
$FORM->delete(grep /^supgroup\d+/, $FORM->param);
|
||||
# Add the current values
|
||||
for ($_ = 0; $_ < @_; $_++) {
|
||||
$FORM->param("supgroup$_" . "sn", $_[$_]);
|
||||
$FORM->param("supgroup$_", 1) if exists $_{$_[$_]};
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
218
htdocs/emandy/magicat/cgi-bin/legend.cgi
Executable file
218
htdocs/emandy/magicat/cgi-bin/legend.cgi
Executable file
@@ -0,0 +1,218 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Mandy Wu's Website
|
||||
# legend.cgi: The blog article administration.
|
||||
|
||||
# Copyright (c) 2006-2021 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-11-15
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::emandy;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
sub check_get();
|
||||
sub check_post();
|
||||
sub html_page($);
|
||||
sub fetch_curitem();
|
||||
|
||||
initenv(-restricted => 1,
|
||||
-this_table => "legend",
|
||||
-dbi_lock => {"legend" => LOCK_EX},
|
||||
-lastmod => 1,
|
||||
-page_param => {"keywords" => N_("legend")});
|
||||
|
||||
main;
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
my ($error, $success, $processor);
|
||||
|
||||
# If the request is a GET query
|
||||
if ($ENV{"REQUEST_METHOD"} ne "POST") {
|
||||
$error = check_get;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
html_page $error;
|
||||
|
||||
# Display the page
|
||||
} else {
|
||||
html_page retrieve_status;
|
||||
}
|
||||
|
||||
# If a form was POSTed from the client
|
||||
} else {
|
||||
$error = check_post;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
error_redirect $error;
|
||||
|
||||
# Else, save the data
|
||||
} else {
|
||||
$processor = new Selima::emandy::Processor::Legend($POST);
|
||||
$success = $processor->process;
|
||||
success_redirect $success;
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# check_get: Check the GET arguments
|
||||
sub check_get() {
|
||||
local ($_, %_);
|
||||
my $error;
|
||||
|
||||
# A form is requested
|
||||
if (is_form) {
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Start from the default language
|
||||
return {"msg"=>N_("Please write a new legend entry from [_1]."),
|
||||
"margs"=>["_DEFAULT_LANG"],
|
||||
"isform"=>0}
|
||||
if getlang ne $DEFAULT_LANG;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
}
|
||||
# List handler handles its own error
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# check_post: Check the POSTed form
|
||||
sub check_post() {
|
||||
local ($_, %_);
|
||||
my ($checker, $error);
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Start from the default language
|
||||
return {"msg"=>N_("Please write a new legend entry from [_1]."),
|
||||
"margs"=>["_DEFAULT_LANG"],
|
||||
"isform"=>0}
|
||||
if getlang ne $DEFAULT_LANG;
|
||||
# Run the checker
|
||||
$checker = new Selima::emandy::Checker::Legend(curform);
|
||||
$error = $checker->check(qw(title body));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
# Run the checker
|
||||
$checker = new Selima::emandy::Checker::Legend(curform);
|
||||
$checker->redir(qw(del));
|
||||
$error = $checker->check(qw(title body));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;;
|
||||
# Run the checker
|
||||
$checker = new Selima::emandy::Checker::Legend(curform);
|
||||
$checker->redir(qw(cancel));
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# html_page: Display the page
|
||||
sub html_page($) {
|
||||
local ($_, %_);
|
||||
my ($status, $LIST, $FORM);
|
||||
$status = $_[0];
|
||||
# A form is requested
|
||||
if (is_form $status) {
|
||||
$FORM = new Selima::emandy::Form::Legend($status);
|
||||
html_header $FORM->{"title"};
|
||||
html_errmsg $status;
|
||||
$FORM->html;
|
||||
html_footer;
|
||||
|
||||
# List the available items
|
||||
} else {
|
||||
$LIST = new Selima::emandy::List::Legend;
|
||||
html_header $LIST->{"title"}, $LIST->page_param;
|
||||
html_errmsg $status;
|
||||
$LIST->html;
|
||||
html_footer;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
##################################
|
||||
# Subroutines to manage the data #
|
||||
##################################
|
||||
# fetch_curitem: Fetch the current item
|
||||
sub fetch_curitem() {
|
||||
local ($_, %_);
|
||||
my ($sn, $FORM);
|
||||
|
||||
# Return if fetched before
|
||||
return if scalar(keys %CURRENT) > 0;
|
||||
|
||||
# Obtain the current form
|
||||
$FORM = curform;
|
||||
# No item specified
|
||||
return {"msg"=>N_("Please select the legend entry."),
|
||||
"isform"=>0}
|
||||
if !defined $FORM->param("sn");
|
||||
$sn = $FORM->param("sn");
|
||||
|
||||
# Find the record
|
||||
%CURRENT = fetchrec $sn, $THIS_TABLE;
|
||||
# If this record exist
|
||||
return {"msg"=>N_("This legend entry does not exist anymore. Please select another one."),
|
||||
"isform"=>0}
|
||||
if scalar(keys %CURRENT) == 0;
|
||||
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
292
htdocs/emandy/magicat/cgi-bin/linkcat.cgi
Executable file
292
htdocs/emandy/magicat/cgi-bin/linkcat.cgi
Executable file
@@ -0,0 +1,292 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Mandy Wu's Website
|
||||
# linkcat.cgi: The related-link category administration.
|
||||
|
||||
# Copyright (c) 2006-2021 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-11-14
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::emandy;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
sub check_get();
|
||||
sub check_post();
|
||||
sub html_page($);
|
||||
sub fetch_curitem();
|
||||
sub import_selparent($);
|
||||
|
||||
initenv(-restricted => 1,
|
||||
-this_table => "linkcat",
|
||||
-dbi_lock => {"linkcat" => LOCK_EX,
|
||||
"links" => LOCK_SH,
|
||||
"linkcatz" => LOCK_SH},
|
||||
-lastmod => 0,
|
||||
-page_param => {"keywords" => N_("link categories")});
|
||||
|
||||
main;
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
my ($error, $success, $processor);
|
||||
|
||||
# If the request is a GET query
|
||||
if ($ENV{"REQUEST_METHOD"} ne "POST") {
|
||||
$error = check_get;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
html_page $error;
|
||||
|
||||
# Display the page
|
||||
} else {
|
||||
html_page retrieve_status;
|
||||
}
|
||||
|
||||
# If a form was POSTed from the client
|
||||
} else {
|
||||
$error = check_post;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
error_redirect $error;
|
||||
|
||||
# Else, save the data
|
||||
} else {
|
||||
$processor = new Selima::Processor::LinkCat($POST);
|
||||
$success = $processor->process;
|
||||
success_redirect $success;
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# check_get: Check the GET arguments
|
||||
sub check_get() {
|
||||
local ($_, %_);
|
||||
my $error;
|
||||
|
||||
# A form is requested
|
||||
if (is_form) {
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Nothing to check on a new form
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
return {"msg"=>N_("This category has [numerate,_1,a subcategory,subcategories]. It cannot be deleted. To delete the category, [numerate,_1,its subcategory,all of its subcategories] must first be deleted."),
|
||||
"margs"=>[$CURRENT{"scatcount"}],
|
||||
"isform"=>0}
|
||||
if $CURRENT{"scatcount"} > 0;
|
||||
return {"msg"=>N_("This category has [numerate,_1,a link,links]. It cannot be deleted. To delete the category, [numerate,_1,its link,all of its links] must first be deleted."),
|
||||
"margs"=>[$CURRENT{"linkcount"}],
|
||||
"isform"=>0}
|
||||
if $CURRENT{"linkcount"} > 0;
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
}
|
||||
# List handler handles its own error
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# check_post: Check the POSTed form
|
||||
sub check_post() {
|
||||
local ($_, %_);
|
||||
my ($checker, $error);
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::LinkCat(curform);
|
||||
$checker->redir(qw(selparent delparent));
|
||||
$error = $checker->check(qw(parent id ord title kw));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::LinkCat(curform);
|
||||
$checker->redir(qw(del selparent delparent));
|
||||
$error = $checker->check(qw(parent id ord title kw));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::LinkCat(curform);
|
||||
$checker->redir(qw(cancel));
|
||||
return {"msg"=>N_("This category has [numerate,_1,a subcategory,subcategories]. It cannot be deleted. To delete the category, [numerate,_1,its subcategory,all of its subcategories] must first be deleted."),
|
||||
"margs"=>[$CURRENT{"scatcount"}],
|
||||
"isform"=>0}
|
||||
if $CURRENT{"scatcount"} > 0;
|
||||
return {"msg"=>N_("This category has [numerate,_1,a link,links]. It cannot be deleted. To delete the category, [numerate,_1,its link,all of its links] must first be deleted."),
|
||||
"margs"=>[$CURRENT{"linkcount"}],
|
||||
"isform"=>0}
|
||||
if $CURRENT{"linkcount"} > 0;
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# html_page: Display the page
|
||||
sub html_page($) {
|
||||
local ($_, %_);
|
||||
my ($status, $LIST, $FORM);
|
||||
$status = $_[0];
|
||||
# A form is requested
|
||||
if (is_form $status) {
|
||||
$FORM = new Selima::Form::LinkCat($status);
|
||||
html_header $FORM->{"title"};
|
||||
html_errmsg $status;
|
||||
$FORM->html;
|
||||
html_footer;
|
||||
|
||||
# List the available items
|
||||
} else {
|
||||
$LIST = new Selima::List::LinkCat;
|
||||
html_header $LIST->{"title"}, $LIST->page_param;
|
||||
html_errmsg $status;
|
||||
$LIST->html;
|
||||
html_footer;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
##################################
|
||||
# Subroutines to manage the data #
|
||||
##################################
|
||||
# fetch_curitem: Fetch the current item
|
||||
sub fetch_curitem() {
|
||||
local ($_, %_);
|
||||
my ($sn, $FORM, $sth, $sql, $row);
|
||||
my ($lang, $lndb, $lndbdef, $langfile, $title);
|
||||
|
||||
# Return if fetched before
|
||||
return if scalar(keys %CURRENT) > 0;
|
||||
|
||||
# Obtain the current form
|
||||
$FORM = curform;
|
||||
# No item specified
|
||||
return {"msg"=>N_("Please select the category."),
|
||||
"isform"=>0}
|
||||
if !defined $FORM->param("sn");
|
||||
$sn = $FORM->param("sn");
|
||||
|
||||
# Find the record
|
||||
%CURRENT = fetchrec $sn, $THIS_TABLE;
|
||||
# If this record exist
|
||||
return {"msg"=>N_("This category does not exist anymore. Please select another one."),
|
||||
"isform"=>0}
|
||||
if scalar(keys %CURRENT) == 0;
|
||||
|
||||
$lang = getlang;
|
||||
$lndb = getlang LN_DATABASE;
|
||||
$lndbdef = ln $DEFAULT_LANG, LN_DATABASE;
|
||||
$langfile = getlang LN_FILENAME;
|
||||
|
||||
# Obtain the belonging subcategories list
|
||||
@_ = qw();
|
||||
push @_, "sn AS sn";
|
||||
if (@ALL_LINGUAS > 1) {
|
||||
$title = $lang eq $DEFAULT_LANG? "title_$lndb":
|
||||
"COALESCE(title_$lndb, title_$lndbdef)";
|
||||
push @_, "linkcat_fulltitle('$lang', parent, $title) AS title";
|
||||
} else {
|
||||
push @_, "linkcat_fulltitle(parent, title) AS title";
|
||||
}
|
||||
push @_, $DBH->strcat("'/links'", "linkcat_path(sn, id, parent)")
|
||||
. " AS url";
|
||||
$sql = "SELECT " . join(", ", @_) . " FROM linkcat"
|
||||
. " WHERE linkcat_ischild($sn, sn)"
|
||||
. " ORDER BY linkcat_fullord(parent, ord);\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$CURRENT{"scatcount"} = $sth->rows;
|
||||
for ($_ = 0; $_ < $CURRENT{"scatcount"}; $_++) {
|
||||
$row = $sth->fetchrow_hashref;
|
||||
$CURRENT{"scat$_" . "sn"} = $$row{"sn"};
|
||||
$CURRENT{"scat$_" . "title"} = $$row{"title"};
|
||||
$CURRENT{"scat$_" . "url"} = $$row{"url"};
|
||||
}
|
||||
|
||||
# Obtain the belonging links list
|
||||
@_ = qw();
|
||||
push @_, "links.sn AS sn";
|
||||
push @_, "links.title AS title";
|
||||
push @_, "url AS url";
|
||||
$sql = "SELECT " . join(", ", @_) . " FROM links"
|
||||
. " INNER JOIN linkcatz ON linkcatz.link=links.sn"
|
||||
. " WHERE linkcatz.cat=$sn"
|
||||
. " ORDER BY title;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$CURRENT{"linkcount"} = $sth->rows;
|
||||
for ($_ = 0; $_ < $CURRENT{"linkcount"}; $_++) {
|
||||
$row = $sth->fetchrow_hashref;
|
||||
$CURRENT{"link$_" . "sn"} = $$row{"sn"};
|
||||
$CURRENT{"link$_" . "title"} = $$row{"title"};
|
||||
$CURRENT{"link$_" . "url"} = $$row{"url"};
|
||||
}
|
||||
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# import_selparent: Import the selected parent into the retrieved form
|
||||
sub import_selparent($) {
|
||||
local ($_, %_);
|
||||
my $FORM;
|
||||
$FORM = $_[0];
|
||||
if ( defined $GET->param("selsn")
|
||||
&& check_sn_in ${$GET->param_fetch("selsn")}[0], "linkcat") {
|
||||
$FORM->param("parent", $GET->param("selsn"));
|
||||
$FORM->param("topmost", "false");
|
||||
}
|
||||
return;
|
||||
}
|
||||
236
htdocs/emandy/magicat/cgi-bin/linkcatz.cgi
Executable file
236
htdocs/emandy/magicat/cgi-bin/linkcatz.cgi
Executable file
@@ -0,0 +1,236 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Mandy Wu's Website
|
||||
# linkcatz.cgi: The related-link category membership administration.
|
||||
|
||||
# Copyright (c) 2006-2021 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-11-14
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::emandy;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
sub check_get();
|
||||
sub check_post();
|
||||
sub html_page($);
|
||||
sub fetch_curitem();
|
||||
sub import_selcat($);
|
||||
sub import_sellink($);
|
||||
|
||||
initenv(-restricted => 1,
|
||||
-this_table => "linkcatz",
|
||||
-dbi_lock => {"linkcatz" => LOCK_EX,
|
||||
"linkcat" => LOCK_SH,
|
||||
"links" => LOCK_SH},
|
||||
-lastmod => 1,
|
||||
-page_param => {"keywords" => N_("link categorization")});
|
||||
|
||||
main;
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
my ($error, $success, $processor);
|
||||
|
||||
# If the request is a GET query
|
||||
if ($ENV{"REQUEST_METHOD"} ne "POST") {
|
||||
$error = check_get;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
html_page $error;
|
||||
|
||||
# Display the page
|
||||
} else {
|
||||
html_page retrieve_status;
|
||||
}
|
||||
|
||||
# If a form was POSTed from the client
|
||||
} else {
|
||||
$error = check_post;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
error_redirect $error;
|
||||
|
||||
# Else, save the data
|
||||
} else {
|
||||
$processor = new Selima::Processor::LinkCatz($POST);
|
||||
$success = $processor->process;
|
||||
success_redirect $success;
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# check_get: Check the GET arguments
|
||||
sub check_get() {
|
||||
local ($_, %_);
|
||||
my $error;
|
||||
|
||||
# A form is requested
|
||||
if (is_form) {
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Nothing to check on a new form
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
}
|
||||
# List handler handles its own error
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# check_post: Check the POSTed form
|
||||
sub check_post() {
|
||||
local ($_, %_);
|
||||
my ($checker, $error);
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::LinkCatz(curform);
|
||||
$checker->redir(qw(selcat delcat sellink dellink));
|
||||
$error = $checker->check(qw(cat link));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::LinkCatz(curform);
|
||||
$checker->redir(qw(del selcat delcat sellink dellink));
|
||||
$error = $checker->check(qw(cat link));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::LinkCatz(curform);
|
||||
$checker->redir(qw(cancel));
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# html_page: Display the page
|
||||
sub html_page($) {
|
||||
local ($_, %_);
|
||||
my ($status, $LIST, $FORM);
|
||||
$status = $_[0];
|
||||
# A form is requested
|
||||
if (is_form $status) {
|
||||
$FORM = new Selima::Form::LinkCatz($status);
|
||||
html_header $FORM->{"title"};
|
||||
html_errmsg $status;
|
||||
$FORM->html;
|
||||
html_footer;
|
||||
|
||||
# List the available items
|
||||
} else {
|
||||
$LIST = new Selima::List::LinkCatz;
|
||||
html_header $LIST->{"title"}, $LIST->page_param;
|
||||
html_errmsg $status;
|
||||
$LIST->html;
|
||||
html_footer;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
##################################
|
||||
# Subroutines to manage the data #
|
||||
##################################
|
||||
# fetch_curitem: Fetch the current item
|
||||
sub fetch_curitem() {
|
||||
local ($_, %_);
|
||||
my ($sn, $FORM);
|
||||
|
||||
# Return if fetched before
|
||||
return if scalar(keys %CURRENT) > 0;
|
||||
|
||||
# Obtain the current form
|
||||
$FORM = curform;
|
||||
# No item specified
|
||||
return {"msg"=>N_("Please select the categorization record."),
|
||||
"isform"=>0}
|
||||
if !defined $FORM->param("sn");
|
||||
$sn = $FORM->param("sn");
|
||||
|
||||
# Find the record
|
||||
%CURRENT = fetchrec $sn, $THIS_TABLE;
|
||||
# If this record exist
|
||||
return {"msg"=>N_("This categorization record does not exist anymore. Please select another one."),
|
||||
"isform"=>0}
|
||||
if scalar(keys %CURRENT) == 0;
|
||||
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# import_selcat: Import the selected category into the retrieved form
|
||||
sub import_selcat($) {
|
||||
local ($_, %_);
|
||||
my $FORM;
|
||||
$FORM = $_[0];
|
||||
$FORM->param("cat", $GET->param("selsn"))
|
||||
if defined $GET->param("selsn")
|
||||
&& check_sn_in ${$GET->param_fetch("selsn")}[0], "linkcat";
|
||||
return;
|
||||
}
|
||||
|
||||
# import_sellink: Import the selected link into the retrieved form
|
||||
sub import_sellink($) {
|
||||
local ($_, %_);
|
||||
my $FORM;
|
||||
$FORM = $_[0];
|
||||
$FORM->param("link", $GET->param("selsn"))
|
||||
if defined $GET->param("selsn")
|
||||
&& check_sn_in ${$GET->param_fetch("selsn")}[0], "links";
|
||||
return $FORM;
|
||||
}
|
||||
240
htdocs/emandy/magicat/cgi-bin/links.cgi
Executable file
240
htdocs/emandy/magicat/cgi-bin/links.cgi
Executable file
@@ -0,0 +1,240 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Mandy Wu's Website
|
||||
# links.cgi: The related-link administration.
|
||||
|
||||
# Copyright (c) 2006-2021 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-11-14
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::emandy;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
sub check_get();
|
||||
sub check_post();
|
||||
sub html_page($);
|
||||
sub fetch_curitem();
|
||||
|
||||
initenv(-restricted => 1,
|
||||
-this_table => "links",
|
||||
-dbi_lock => {"links" => LOCK_EX,
|
||||
"linkcatz" => LOCK_EX,
|
||||
"linkcat" => LOCK_SH},
|
||||
-lastmod => 1,
|
||||
-page_param => {"keywords" => N_("related links")});
|
||||
|
||||
main;
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
my ($error, $success, $processor);
|
||||
|
||||
# If the request is a GET query
|
||||
if ($ENV{"REQUEST_METHOD"} ne "POST") {
|
||||
$error = check_get;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
html_page $error;
|
||||
|
||||
# Display the page
|
||||
} else {
|
||||
html_page retrieve_status;
|
||||
}
|
||||
|
||||
# If a form was POSTed from the client
|
||||
} else {
|
||||
$error = check_post;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
error_redirect $error;
|
||||
|
||||
# Else, save the data
|
||||
} else {
|
||||
$processor = new Selima::Processor::Link($POST);
|
||||
$success = $processor->process;
|
||||
success_redirect $success;
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# check_get: Check the GET arguments
|
||||
sub check_get() {
|
||||
local ($_, %_);
|
||||
my $error;
|
||||
|
||||
# A form is requested
|
||||
if (is_form) {
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
}
|
||||
# List handler handles its own error
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# check_post: Check the POSTed form
|
||||
sub check_post() {
|
||||
local ($_, %_);
|
||||
my ($checker, $error);
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::Link(curform);
|
||||
$error = $checker->check(qw(title title_2ln url icon
|
||||
email addr tel fax dsc cats));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::Link(curform);
|
||||
$checker->redir(qw(del));
|
||||
$error = $checker->check(qw(title title_2ln url icon
|
||||
email addr tel fax dsc cats));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::Link(curform);
|
||||
$checker->redir(qw(cancel));
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# html_page: Display the page
|
||||
sub html_page($) {
|
||||
local ($_, %_);
|
||||
my ($status, $LIST, $FORM);
|
||||
$status = $_[0];
|
||||
# A form is requested
|
||||
if (is_form $status) {
|
||||
$FORM = new Selima::Form::Link($status);
|
||||
html_header $FORM->{"title"};
|
||||
html_errmsg $status;
|
||||
$FORM->html;
|
||||
html_footer;
|
||||
|
||||
# List the available items
|
||||
} else {
|
||||
$LIST = new Selima::List::Links;
|
||||
html_header $LIST->{"title"}, $LIST->page_param;
|
||||
html_errmsg $status;
|
||||
$LIST->html;
|
||||
html_footer;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
##################################
|
||||
# Subroutines to manage the data #
|
||||
##################################
|
||||
# fetch_curitem: Fetch the current item
|
||||
sub fetch_curitem() {
|
||||
local ($_, %_);
|
||||
my ($sn, $FORM, $sth, $sql, $row);
|
||||
my ($lang, $lndb, $lndbdef, $title);
|
||||
|
||||
# Return if fetched before
|
||||
return if scalar(keys %CURRENT) > 0;
|
||||
|
||||
# Obtain the current form
|
||||
$FORM = curform;
|
||||
# No item specified
|
||||
return {"msg"=>N_("Please select the related link."),
|
||||
"isform"=>0}
|
||||
if !defined $FORM->param("sn");
|
||||
$sn = $FORM->param("sn");
|
||||
|
||||
# Find the record
|
||||
%CURRENT = fetchrec $sn, $THIS_TABLE;
|
||||
# If this record exist
|
||||
return {"msg"=>N_("This related link does not exist anymore. Please select another one."),
|
||||
"isform"=>0}
|
||||
if scalar(keys %CURRENT) == 0;
|
||||
|
||||
$lang = getlang;
|
||||
$lndb = getlang LN_DATABASE;
|
||||
$lndbdef = ln $DEFAULT_LANG, LN_DATABASE;
|
||||
|
||||
# Obtain the parent categories list
|
||||
@_ = qw();
|
||||
push @_, "linkcat.sn AS sn";
|
||||
if (@ALL_LINGUAS > 1) {
|
||||
$title = $lang eq $DEFAULT_LANG? "linkcat.title_$lndb":
|
||||
"COALESCE(linkcat.title_$lndb, linkcat.title_$lndbdef)";
|
||||
push @_, "linkcat_fulltitle('$lang', linkcat.parent, $title) AS title";
|
||||
} else {
|
||||
push @_, "linkcat_fulltitle(linkcat.parent, linkcat.title) AS title";
|
||||
}
|
||||
$sql = "SELECT " . join(", ", @_) . " FROM linkcat"
|
||||
. " INNER JOIN linkcatz ON linkcatz.cat=linkcat.sn"
|
||||
. " WHERE linkcatz.link=$sn"
|
||||
. " ORDER BY linkcat_fullord(linkcat.parent, linkcat.ord);\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$CURRENT{"catcount"} = $sth->rows;
|
||||
for ($_ = 0; $_ < $CURRENT{"catcount"}; $_++) {
|
||||
$row = $sth->fetchrow_hashref;
|
||||
$CURRENT{"cat$_"} = $$row{"sn"};
|
||||
$CURRENT{"cat$_" . "title"} = $$row{"title"};
|
||||
}
|
||||
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
158
htdocs/emandy/magicat/cgi-bin/logout.cgi
Executable file
158
htdocs/emandy/magicat/cgi-bin/logout.cgi
Executable file
@@ -0,0 +1,158 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Mandy Wu's Website
|
||||
# logout.cgi: The log-out script.
|
||||
|
||||
# Copyright (c) 2006-2021 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-11-14
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::emandy;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
sub check_get();
|
||||
sub check_post();
|
||||
sub html_page($);
|
||||
sub html_logoutform();
|
||||
sub html_relogin();
|
||||
|
||||
initenv(-dbi => DBI_NONE,
|
||||
-lastmod => 1,
|
||||
-page_param => {"keywords" => N_("log out")});
|
||||
|
||||
main;
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
my ($error, $success, $processor);
|
||||
|
||||
# If the request is a GET query
|
||||
if ($ENV{"REQUEST_METHOD"} ne "POST") {
|
||||
$error = check_get;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
html_page $error;
|
||||
|
||||
# Display the page
|
||||
} else {
|
||||
html_page retrieve_status;
|
||||
}
|
||||
|
||||
# If a form was POSTed from the client
|
||||
} else {
|
||||
$error = check_post;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
error_redirect $error;
|
||||
|
||||
# Else, save the data
|
||||
} else {
|
||||
$processor = new Selima::Processor::LogOut($POST);
|
||||
$success = $processor->process;
|
||||
success_redirect $success;
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# check_get: Check the GET arguments
|
||||
sub check_get() {
|
||||
local ($_, %_);
|
||||
my $status;
|
||||
# There is a result to display
|
||||
$status = retrieve_status;
|
||||
# Successfully logged out
|
||||
if ( defined $status
|
||||
&& exists $$status{"status"}
|
||||
&& $$status{"status"} eq "success") {
|
||||
# Nothing to check
|
||||
return;
|
||||
}
|
||||
# Check if this user has logged in
|
||||
unauth unless defined get_login_sn;
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# check_post: Check the POSTed form
|
||||
sub check_post() {
|
||||
local ($_, %_);
|
||||
# Check if this user has logged in
|
||||
unauth unless defined get_login_sn;
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# html_page: Display the page
|
||||
sub html_page($) {
|
||||
local ($_, %_);
|
||||
my $status;
|
||||
$status = $_[0];
|
||||
# Not logged out yet
|
||||
if (defined get_login_sn) {
|
||||
html_header __("Log Out");
|
||||
html_errmsg $status;
|
||||
html_logoutform;
|
||||
html_footer;
|
||||
|
||||
# Logged out
|
||||
} else {
|
||||
html_header __("Log Out");
|
||||
html_errmsg $status;
|
||||
html_relogin;
|
||||
html_footer;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
##################################
|
||||
# Subroutines to manage the data #
|
||||
##################################
|
||||
# html_logoutform: Display a form to log out
|
||||
sub html_logoutform() {
|
||||
local ($_, %_);
|
||||
my ($msg, $submit);
|
||||
$msg = h(__("Are you sure you want to log out?"));
|
||||
$submit = h(__("Log out"));
|
||||
print << "EOT";
|
||||
<form action="$REQUEST_FILE" method="post">
|
||||
<div>
|
||||
<p>$msg</p>
|
||||
<input type="submit" value="$submit" />
|
||||
</div>
|
||||
</form>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
# html_relogin: Display links to log in again
|
||||
sub html_relogin() {
|
||||
local ($_, %_);
|
||||
$_ = h(__("Log in again."));
|
||||
print << "EOT";
|
||||
<p><a href="/magicat/cgi-bin/login.cgi">$_</a></p>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
221
htdocs/emandy/magicat/cgi-bin/material.cgi
Executable file
221
htdocs/emandy/magicat/cgi-bin/material.cgi
Executable file
@@ -0,0 +1,221 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Mandy Wu's Website
|
||||
# material.cgi: The historical material administration.
|
||||
|
||||
# Copyright (c) 2006-2021 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-11-23
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::emandy;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
sub check_get();
|
||||
sub check_post();
|
||||
sub html_page($);
|
||||
sub fetch_curitem();
|
||||
|
||||
initenv(-restricted => 1,
|
||||
-this_table => "material",
|
||||
-dbi_lock => {"material" => LOCK_EX,
|
||||
"mtrltype" => LOCK_SH},
|
||||
-lastmod => 1,
|
||||
-page_param => {"keywords" => N_("materials")});
|
||||
|
||||
main;
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
my ($error, $success, $processor);
|
||||
|
||||
# If the request is a GET query
|
||||
if ($ENV{"REQUEST_METHOD"} ne "POST") {
|
||||
$error = check_get;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
html_page $error;
|
||||
|
||||
# Display the page
|
||||
} else {
|
||||
html_page retrieve_status;
|
||||
}
|
||||
|
||||
# If a form was POSTed from the client
|
||||
} else {
|
||||
$error = check_post;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
error_redirect $error;
|
||||
|
||||
# Else, save the data
|
||||
} else {
|
||||
$processor = new Selima::emandy::Processor::Material($POST);
|
||||
$success = $processor->process;
|
||||
success_redirect $success;
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# check_get: Check the GET arguments
|
||||
sub check_get() {
|
||||
local ($_, %_);
|
||||
my $error;
|
||||
|
||||
# A form is requested
|
||||
if (is_form) {
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Start from the default language
|
||||
return {"msg"=>N_("Please create a new material from [_1]."),
|
||||
"margs"=>["_DEFAULT_LANG"],
|
||||
"isform"=>0}
|
||||
if getlang ne $DEFAULT_LANG;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
}
|
||||
# List handler handles its own error
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# check_post: Check the POSTed form
|
||||
sub check_post() {
|
||||
local ($_, %_);
|
||||
my ($checker, $error);
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Start from the default language
|
||||
return {"msg"=>N_("Please create a new material from [_1]."),
|
||||
"margs"=>["_DEFAULT_LANG"],
|
||||
"isform"=>0}
|
||||
if getlang ne $DEFAULT_LANG;
|
||||
# Run the checker
|
||||
$checker = new Selima::emandy::Checker::Material(curform);
|
||||
$error = $checker->check(qw(type year title body source
|
||||
author notes));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
# Run the checker
|
||||
$checker = new Selima::emandy::Checker::Material(curform);
|
||||
$checker->redir(qw(del));
|
||||
$error = $checker->check(qw(type year title body source
|
||||
author notes));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;;
|
||||
# Run the checker
|
||||
$checker = new Selima::emandy::Checker::Material(curform);
|
||||
$checker->redir(qw(cancel));
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# html_page: Display the page
|
||||
sub html_page($) {
|
||||
local ($_, %_);
|
||||
my ($status, $LIST, $FORM);
|
||||
$status = $_[0];
|
||||
# A form is requested
|
||||
if (is_form $status) {
|
||||
$FORM = new Selima::emandy::Form::Material($status);
|
||||
html_header $FORM->{"title"};
|
||||
html_errmsg $status;
|
||||
$FORM->html;
|
||||
html_footer;
|
||||
|
||||
# List the available items
|
||||
} else {
|
||||
$LIST = new Selima::emandy::List::Material;
|
||||
html_header $LIST->{"title"}, $LIST->page_param;
|
||||
html_errmsg $status;
|
||||
$LIST->html;
|
||||
html_footer;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
##################################
|
||||
# Subroutines to manage the data #
|
||||
##################################
|
||||
# fetch_curitem: Fetch the current item
|
||||
sub fetch_curitem() {
|
||||
local ($_, %_);
|
||||
my ($sn, $FORM);
|
||||
|
||||
# Return if fetched before
|
||||
return if scalar(keys %CURRENT) > 0;
|
||||
|
||||
# Obtain the current form
|
||||
$FORM = curform;
|
||||
# No item specified
|
||||
return {"msg"=>N_("Please select the material."),
|
||||
"isform"=>0}
|
||||
if !defined $FORM->param("sn");
|
||||
$sn = $FORM->param("sn");
|
||||
|
||||
# Find the record
|
||||
%CURRENT = fetchrec $sn, $THIS_TABLE;
|
||||
# If this record exist
|
||||
return {"msg"=>N_("This material does not exist anymore. Please select another one."),
|
||||
"isform"=>0}
|
||||
if scalar(keys %CURRENT) == 0;
|
||||
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
243
htdocs/emandy/magicat/cgi-bin/mtrltype.cgi
Executable file
243
htdocs/emandy/magicat/cgi-bin/mtrltype.cgi
Executable file
@@ -0,0 +1,243 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Mandy Wu's Website
|
||||
# mtrltype.cgi: The historical material type administration.
|
||||
|
||||
# Copyright (c) 2006-2021 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-11-23
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::emandy;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
sub check_get();
|
||||
sub check_post();
|
||||
sub html_page($);
|
||||
sub fetch_curitem();
|
||||
|
||||
initenv(-restricted => 1,
|
||||
-this_table => "mtrltype",
|
||||
-dbi_lock => {"mtrltype" => LOCK_EX,
|
||||
"material" => LOCK_SH},
|
||||
-lastmod => 1,
|
||||
-page_param => {"keywords" => N_("materials")});
|
||||
|
||||
main;
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
my ($error, $success, $processor);
|
||||
|
||||
# If the request is a GET query
|
||||
if ($ENV{"REQUEST_METHOD"} ne "POST") {
|
||||
$error = check_get;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
html_page $error;
|
||||
|
||||
# Display the page
|
||||
} else {
|
||||
html_page retrieve_status;
|
||||
}
|
||||
|
||||
# If a form was POSTed from the client
|
||||
} else {
|
||||
$error = check_post;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
error_redirect $error;
|
||||
|
||||
# Else, save the data
|
||||
} else {
|
||||
$processor = new Selima::emandy::Processor::MtrlType($POST);
|
||||
$success = $processor->process;
|
||||
success_redirect $success;
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# check_get: Check the GET arguments
|
||||
sub check_get() {
|
||||
local ($_, %_);
|
||||
my $error;
|
||||
|
||||
# A form is requested
|
||||
if (is_form) {
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Start from the default language
|
||||
return {"msg"=>N_("Please create a new type from [_1]."),
|
||||
"margs"=>["_DEFAULT_LANG"],
|
||||
"isform"=>0}
|
||||
if getlang ne $DEFAULT_LANG;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
return {"msg"=>N_("This type has [numerate,_1,a material,materials]. It cannot be deleted. To delete the type, [numerate,_1,its material,all of its materials] must first be deleted."),
|
||||
"margs"=>[$CURRENT{"mtrlcount"}],
|
||||
"isform"=>0}
|
||||
if $CURRENT{"mtrlcount"} > 0;
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
}
|
||||
# List handler handles its own error
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# check_post: Check the POSTed form
|
||||
sub check_post() {
|
||||
local ($_, %_);
|
||||
my ($checker, $error);
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Start from the default language
|
||||
return {"msg"=>N_("Please create a new type from [_1]."),
|
||||
"margs"=>["_DEFAULT_LANG"],
|
||||
"isform"=>0}
|
||||
if getlang ne $DEFAULT_LANG;
|
||||
# Run the checker
|
||||
$checker = new Selima::emandy::Checker::MtrlType(curform);
|
||||
$error = $checker->check(qw(ord title));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
# Run the checker
|
||||
$checker = new Selima::emandy::Checker::MtrlType(curform);
|
||||
$checker->redir(qw(del));
|
||||
$error = $checker->check(qw(ord title));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;;
|
||||
# Run the checker
|
||||
$checker = new Selima::emandy::Checker::MtrlType(curform);
|
||||
$checker->redir(qw(cancel));
|
||||
return {"msg"=>N_("This type has [numerate,_1,a material,materials]. It cannot be deleted. To delete the type, [numerate,_1,its material,all of its materials] must first be deleted."),
|
||||
"margs"=>[$CURRENT{"mtrlcount"}],
|
||||
"isform"=>0}
|
||||
if $CURRENT{"mtrlcount"} > 0;
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# html_page: Display the page
|
||||
sub html_page($) {
|
||||
local ($_, %_);
|
||||
my ($status, $LIST, $FORM);
|
||||
$status = $_[0];
|
||||
# A form is requested
|
||||
if (is_form $status) {
|
||||
$FORM = new Selima::emandy::Form::MtrlType($status);
|
||||
html_header $FORM->{"title"};
|
||||
html_errmsg $status;
|
||||
$FORM->html;
|
||||
html_footer;
|
||||
|
||||
# List the available items
|
||||
} else {
|
||||
$LIST = new Selima::emandy::List::MtrlType;
|
||||
html_header $LIST->{"title"}, $LIST->page_param;
|
||||
html_errmsg $status;
|
||||
$LIST->html;
|
||||
html_footer;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
##################################
|
||||
# Subroutines to manage the data #
|
||||
##################################
|
||||
# fetch_curitem: Fetch the current item
|
||||
sub fetch_curitem() {
|
||||
local ($_, %_);
|
||||
my ($sn, $FORM, $sth, $sql, $row);
|
||||
|
||||
# Return if fetched before
|
||||
return if scalar(keys %CURRENT) > 0;
|
||||
|
||||
# Obtain the current form
|
||||
$FORM = curform;
|
||||
# No item specified
|
||||
return {"msg"=>N_("Please select the type."),
|
||||
"isform"=>0}
|
||||
if !defined $FORM->param("sn");
|
||||
$sn = $FORM->param("sn");
|
||||
|
||||
# Find the record
|
||||
%CURRENT = fetchrec $sn, $THIS_TABLE;
|
||||
# If this record exist
|
||||
return {"msg"=>N_("This type does not exist anymore. Please select another one."),
|
||||
"isform"=>0}
|
||||
if scalar(keys %CURRENT) == 0;
|
||||
|
||||
# Obtain the belonging materials list
|
||||
@_ = qw();
|
||||
push @_, "sn AS sn";
|
||||
push @_, "title AS title";
|
||||
$sql = "SELECT " . join(", ", @_) . " FROM material"
|
||||
. " WHERE type=$sn"
|
||||
. " ORDER BY title;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$CURRENT{"mtrlcount"} = $sth->rows;
|
||||
for ($_ = 0; $_ < $CURRENT{"mtrlcount"}; $_++) {
|
||||
$row = $sth->fetchrow_hashref;
|
||||
$CURRENT{"mtrl$_" . "sn"} = $$row{"sn"};
|
||||
$CURRENT{"mtrl$_" . "title"} = $$row{"title"};
|
||||
}
|
||||
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
221
htdocs/emandy/magicat/cgi-bin/pages.cgi
Executable file
221
htdocs/emandy/magicat/cgi-bin/pages.cgi
Executable file
@@ -0,0 +1,221 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Mandy Wu's Website
|
||||
# pages.cgi: The web page administration.
|
||||
|
||||
# Copyright (c) 2006-2021 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-11-14
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::emandy;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
sub check_get();
|
||||
sub check_post();
|
||||
sub html_page($);
|
||||
sub fetch_curitem();
|
||||
|
||||
initenv(-restricted => 1,
|
||||
-this_table => "pages",
|
||||
-dbi_lock => {"pages" => LOCK_EX},
|
||||
-lastmod => 1,
|
||||
-page_param => {"keywords" => N_("pages")});
|
||||
|
||||
main;
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
my ($error, $success, $processor);
|
||||
|
||||
# If the request is a GET query
|
||||
if ($ENV{"REQUEST_METHOD"} ne "POST") {
|
||||
$error = check_get;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
html_page $error;
|
||||
|
||||
# Display the page
|
||||
} else {
|
||||
html_page retrieve_status;
|
||||
}
|
||||
|
||||
# If a form was POSTed from the client
|
||||
} else {
|
||||
$error = check_post;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
error_redirect $error;
|
||||
|
||||
# Else, save the data
|
||||
} else {
|
||||
$processor = new Selima::Processor::Page($POST);
|
||||
$success = $processor->process;
|
||||
success_redirect $success;
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# check_get: Check the GET arguments
|
||||
sub check_get() {
|
||||
local ($_, %_);
|
||||
my $error;
|
||||
|
||||
# A form is requested
|
||||
if (is_form) {
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Nothing to check on a new form
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to preview a submitted item
|
||||
} elsif ($_ eq "preview") {
|
||||
# Check at fetch_preview()
|
||||
$error = fetch_preview;
|
||||
return $error if defined $error;
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
}
|
||||
# List handler handles its own error
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# check_post: Check the POSTed form
|
||||
sub check_post() {
|
||||
local ($_, %_);
|
||||
my ($checker, $error);
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::Page(curform);
|
||||
$error = $checker->check(qw(path ord title body kw));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::Page(curform);
|
||||
$checker->redir(qw(del));
|
||||
$error = $checker->check(qw(path ord title body kw));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::Page(curform);
|
||||
$checker->redir(qw(cancel));
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# html_page: Display the page
|
||||
sub html_page($) {
|
||||
local ($_, %_);
|
||||
my ($status, $LIST, $FORM);
|
||||
$status = $_[0];
|
||||
# A form is requested
|
||||
if (is_form $status) {
|
||||
# A form to preview a submitted item
|
||||
if (form_type eq "preview") {
|
||||
html_preview;
|
||||
|
||||
} else {
|
||||
$FORM = new Selima::Form::Page($status);
|
||||
html_header $FORM->{"title"};
|
||||
html_errmsg $status;
|
||||
$FORM->html;
|
||||
html_footer;
|
||||
}
|
||||
|
||||
# List the available items
|
||||
} else {
|
||||
$LIST = new Selima::List::Pages;
|
||||
html_header $LIST->{"title"}, $LIST->page_param;
|
||||
html_errmsg $status;
|
||||
$LIST->html;
|
||||
html_footer;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
##################################
|
||||
# Subroutines to manage the data #
|
||||
##################################
|
||||
# fetch_curitem: Fetch the current item
|
||||
sub fetch_curitem() {
|
||||
local ($_, %_);
|
||||
my ($sn, $FORM);
|
||||
|
||||
# Return if fetched before
|
||||
return if scalar(keys %CURRENT) > 0;
|
||||
|
||||
# Obtain the current form
|
||||
$FORM = curform;
|
||||
# No item specified
|
||||
return {"msg"=>N_("Please select the page."),
|
||||
"isform"=>0}
|
||||
if !defined $FORM->param("sn");
|
||||
$sn = $FORM->param("sn");
|
||||
|
||||
# Find the record
|
||||
%CURRENT = fetchrec $sn, $THIS_TABLE;
|
||||
# If this record exist
|
||||
return {"msg"=>N_("This page does not exist anymore. Please select another one."),
|
||||
"isform"=>0}
|
||||
if scalar(keys %CURRENT) == 0;
|
||||
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
105
htdocs/emandy/magicat/cgi-bin/rebuild.cgi
Executable file
105
htdocs/emandy/magicat/cgi-bin/rebuild.cgi
Executable file
@@ -0,0 +1,105 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Mandy Wu's Website
|
||||
# rebuild.cgi: The web page rebuilder.
|
||||
|
||||
# Copyright (c) 2006-2021 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-11-14
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::emandy;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
sub check_get();
|
||||
sub check_post();
|
||||
sub html_page($);
|
||||
|
||||
initenv(-restricted => 1,
|
||||
-lastmod => 1,
|
||||
-page_param => {"keywords" => N_("rebuild pages")});
|
||||
|
||||
main;
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
my ($error, $success, $processor);
|
||||
|
||||
# If the request is a GET query
|
||||
if ($ENV{"REQUEST_METHOD"} ne "POST") {
|
||||
$error = check_get;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
html_page $error;
|
||||
|
||||
# Display the page
|
||||
} else {
|
||||
html_page retrieve_status;
|
||||
}
|
||||
|
||||
# If a form was POSTed from the client
|
||||
} else {
|
||||
$error = check_post;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
error_redirect $error;
|
||||
|
||||
# Else, save the data
|
||||
} else {
|
||||
$processor = new Selima::Processor::Rebuild($POST);
|
||||
$success = $processor->process;
|
||||
success_redirect $success;
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# check_get: Check the GET arguments
|
||||
sub check_get() {
|
||||
# Nothing to check here
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# check_post: Check the POSTed form
|
||||
sub check_post() {
|
||||
local ($_, %_);
|
||||
my ($checker, $error);
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::Rebuild(curform);
|
||||
$error = $checker->check(qw(type));
|
||||
return $error if defined $error;
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# html_page: Display the page
|
||||
sub html_page($) {
|
||||
local ($_, %_);
|
||||
my ($status, $FORM);
|
||||
$status = $_[0];
|
||||
$FORM = new Selima::Form::Rebuild($status);
|
||||
html_header $FORM->{"title"};
|
||||
html_errmsg $status;
|
||||
$FORM->html;
|
||||
html_footer;
|
||||
return;
|
||||
}
|
||||
223
htdocs/emandy/magicat/cgi-bin/scptpriv.cgi
Executable file
223
htdocs/emandy/magicat/cgi-bin/scptpriv.cgi
Executable file
@@ -0,0 +1,223 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Mandy Wu's Website
|
||||
# scptpriv.cgi: The script privilege administration.
|
||||
|
||||
# Copyright (c) 2006-2021 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-11-14
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::emandy;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
sub check_get();
|
||||
sub check_post();
|
||||
sub html_page($);
|
||||
sub fetch_curitem();
|
||||
sub import_selgrp($);
|
||||
|
||||
initenv(-restricted => 1,
|
||||
-this_table => "scptpriv",
|
||||
-dbi_lock => {"scptpriv" => LOCK_EX,
|
||||
"groups" => LOCK_SH},
|
||||
-lastmod => 1,
|
||||
-page_param => {"keywords" => N_("script privilege")});
|
||||
|
||||
main;
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
my ($error, $success, $processor);
|
||||
|
||||
# If the request is a GET query
|
||||
if ($ENV{"REQUEST_METHOD"} ne "POST") {
|
||||
$error = check_get;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
html_page $error;
|
||||
|
||||
# Display the page
|
||||
} else {
|
||||
html_page retrieve_status;
|
||||
}
|
||||
|
||||
# If a form was POSTed from the client
|
||||
} else {
|
||||
$error = check_post;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
error_redirect $error;
|
||||
|
||||
# Else, save the data
|
||||
} else {
|
||||
$processor = new Selima::Processor::ScptPriv($POST);
|
||||
$success = $processor->process;
|
||||
success_redirect $success;
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# check_get: Check the GET arguments
|
||||
sub check_get() {
|
||||
local ($_, %_);
|
||||
my $error;
|
||||
|
||||
# A form is requested
|
||||
if (is_form) {
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Nothing to check on a new form
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
}
|
||||
# List handler handles its own error
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# check_post: Check the POSTed form
|
||||
sub check_post() {
|
||||
local ($_, %_);
|
||||
my ($checker, $error);
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::ScptPriv(curform);
|
||||
$checker->redir(qw(selgrp delgrp));
|
||||
$error = $checker->check(qw(script grp));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::ScptPriv(curform);
|
||||
$checker->redir(qw(del selgrp delgrp));
|
||||
$error = $checker->check(qw(script grp));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::ScptPriv(curform);
|
||||
$checker->redir(qw(cancel));
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# html_page: Display the page
|
||||
sub html_page($) {
|
||||
local ($_, %_);
|
||||
my ($status, $LIST, $FORM);
|
||||
$status = $_[0];
|
||||
# A form is requested
|
||||
if (is_form $status) {
|
||||
$FORM = new Selima::Form::ScptPriv($status);
|
||||
html_header $FORM->{"title"};
|
||||
html_errmsg $status;
|
||||
$FORM->html;
|
||||
html_footer;
|
||||
|
||||
# List the available items
|
||||
} else {
|
||||
$LIST = new Selima::List::ScptPriv;
|
||||
html_header $LIST->{"title"}, $LIST->page_param;
|
||||
html_errmsg $status;
|
||||
$LIST->html;
|
||||
html_footer;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
##################################
|
||||
# Subroutines to manage the data #
|
||||
##################################
|
||||
# fetch_curitem: Fetch the current item
|
||||
sub fetch_curitem() {
|
||||
local ($_, %_);
|
||||
my ($sn, $FORM);
|
||||
|
||||
# Return if fetched before
|
||||
return if scalar(keys %CURRENT) > 0;
|
||||
|
||||
# Obtain the current form
|
||||
$FORM = curform;
|
||||
# No item specified
|
||||
return {"msg"=>N_("Please select the script privilege record."),
|
||||
"isform"=>0}
|
||||
if !defined $FORM->param("sn");
|
||||
$sn = $FORM->param("sn");
|
||||
|
||||
# Find the record
|
||||
%CURRENT = fetchrec $sn, $THIS_TABLE;
|
||||
# If this record exist
|
||||
return {"msg"=>N_("This script privilege record does not exist anymore. Please select another one."),
|
||||
"isform"=>0}
|
||||
if scalar(keys %CURRENT) == 0;
|
||||
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# import_selgrp: Import the selected group into the retrieved form
|
||||
sub import_selgrp($) {
|
||||
local ($_, %_);
|
||||
my $FORM;
|
||||
$FORM = $_[0];
|
||||
$FORM->param("grp", $GET->param("selsn"))
|
||||
if defined $GET->param("selsn")
|
||||
&& check_sn_in ${$GET->param_fetch("selsn")}[0], "groups";
|
||||
return;
|
||||
}
|
||||
40
htdocs/emandy/magicat/cgi-bin/test.cgi
Executable file
40
htdocs/emandy/magicat/cgi-bin/test.cgi
Executable file
@@ -0,0 +1,40 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Mandy Wu's Website
|
||||
# test.cgi: The test script.
|
||||
|
||||
# Copyright (c) 2006-2021 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-11-14
|
||||
|
||||
use 5.008;
|
||||
use utf8;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::emandy;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $r = shift;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
use Time::HiRes qw();
|
||||
initenv;
|
||||
$CONTENT_TYPE = "text/plain";
|
||||
|
||||
|
||||
printf "[%s] Done. %0.10f seconds elapsed.\n",
|
||||
fmttime, Time::HiRes::time-$T_START;
|
||||
exit 0;
|
||||
no utf8;
|
||||
236
htdocs/emandy/magicat/cgi-bin/usermem.cgi
Executable file
236
htdocs/emandy/magicat/cgi-bin/usermem.cgi
Executable file
@@ -0,0 +1,236 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Mandy Wu's Website
|
||||
# usermem.cgi: The user-to-group membership administration.
|
||||
|
||||
# Copyright (c) 2006-2021 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-11-14
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::emandy;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
sub check_get();
|
||||
sub check_post();
|
||||
sub html_page($);
|
||||
sub fetch_curitem();
|
||||
sub import_selgrp($);
|
||||
sub import_selmember($);
|
||||
|
||||
initenv(-restricted => 1,
|
||||
-this_table => "usermem",
|
||||
-dbi_lock => {"usermem" => LOCK_EX,
|
||||
"groups" => LOCK_SH,
|
||||
"users AS usrmembers" => LOCK_SH},
|
||||
-lastmod => 1,
|
||||
-page_param => {"keywords" => N_("user membership")});
|
||||
|
||||
main;
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
my ($error, $success, $processor);
|
||||
|
||||
# If the request is a GET query
|
||||
if ($ENV{"REQUEST_METHOD"} ne "POST") {
|
||||
$error = check_get;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
html_page $error;
|
||||
|
||||
# Display the page
|
||||
} else {
|
||||
html_page retrieve_status;
|
||||
}
|
||||
|
||||
# If a form was POSTed from the client
|
||||
} else {
|
||||
$error = check_post;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
error_redirect $error;
|
||||
|
||||
# Else, save the data
|
||||
} else {
|
||||
$processor = new Selima::Processor::UserMem($POST);
|
||||
$success = $processor->process;
|
||||
success_redirect $success;
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# check_get: Check the GET arguments
|
||||
sub check_get() {
|
||||
local ($_, %_);
|
||||
my $error;
|
||||
|
||||
# A form is requested
|
||||
if (is_form) {
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Nothing to check on a new form
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
}
|
||||
# List handler handles its own error
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# check_post: Check the POSTed form
|
||||
sub check_post() {
|
||||
local ($_, %_);
|
||||
my ($checker, $error);
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::UserMem(curform);
|
||||
$checker->redir(qw(selgrp delgrp selmember delmember));
|
||||
$error = $checker->check(qw(grp member));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::UserMem(curform);
|
||||
$checker->redir(qw(del selgrp delgrp selmember delmember));
|
||||
$error = $checker->check(qw(grp member));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::UserMem(curform);
|
||||
$checker->redir(qw(cancel));
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# html_page: Display the page
|
||||
sub html_page($) {
|
||||
local ($_, %_);
|
||||
my ($status, $LIST, $FORM);
|
||||
$status = $_[0];
|
||||
# A form is requested
|
||||
if (is_form $status) {
|
||||
$FORM = new Selima::Form::UserMem($status);
|
||||
html_header $FORM->{"title"};
|
||||
html_errmsg $status;
|
||||
$FORM->html;
|
||||
html_footer;
|
||||
|
||||
# List the available items
|
||||
} else {
|
||||
$LIST = new Selima::List::UserMem;
|
||||
html_header $LIST->{"title"}, $LIST->page_param;
|
||||
html_errmsg $status;
|
||||
$LIST->html;
|
||||
html_footer;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
##################################
|
||||
# Subroutines to manage the data #
|
||||
##################################
|
||||
# fetch_curitem: Fetch the current item
|
||||
sub fetch_curitem() {
|
||||
local ($_, %_);
|
||||
my ($sn, $FORM);
|
||||
|
||||
# Return if fetched before
|
||||
return if scalar(keys %CURRENT) > 0;
|
||||
|
||||
# Obtain the current form
|
||||
$FORM = curform;
|
||||
# No item specified
|
||||
return {"msg"=>N_("Please select the membership record."),
|
||||
"isform"=>0}
|
||||
if !defined $FORM->param("sn");
|
||||
$sn = $FORM->param("sn");
|
||||
|
||||
# Find the record
|
||||
%CURRENT = fetchrec $sn, $THIS_TABLE;
|
||||
# If this record exist
|
||||
return {"msg"=>N_("This membership record does not exist anymore. Please select another one."),
|
||||
"isform"=>0}
|
||||
if scalar(keys %CURRENT) == 0;
|
||||
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# import_selgrp: Import the selected group into the retrieved form
|
||||
sub import_selgrp($) {
|
||||
local ($_, %_);
|
||||
my $FORM;
|
||||
$FORM = $_[0];
|
||||
$FORM->param("grp", $GET->param("selsn"))
|
||||
if defined $GET->param("selsn")
|
||||
&& check_sn_in ${$GET->param_fetch("selsn")}[0], "groups";
|
||||
return;
|
||||
}
|
||||
|
||||
# import_selmember: Import the selected user into the retrieved form
|
||||
sub import_selmember($) {
|
||||
local ($_, %_);
|
||||
my $FORM;
|
||||
$FORM = $_[0];
|
||||
$FORM->param("member", $GET->param("selsn"))
|
||||
if defined $GET->param("selsn")
|
||||
&& check_sn_in ${$GET->param_fetch("selsn")}[0], "users AS usrmembers";
|
||||
return $FORM;
|
||||
}
|
||||
225
htdocs/emandy/magicat/cgi-bin/userpref.cgi
Executable file
225
htdocs/emandy/magicat/cgi-bin/userpref.cgi
Executable file
@@ -0,0 +1,225 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Mandy Wu's Website
|
||||
# userpref.cgi: The user preference administration.
|
||||
|
||||
# Copyright (c) 2006-2021 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-11-14
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::emandy;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
sub check_get();
|
||||
sub check_post();
|
||||
sub html_page($);
|
||||
sub fetch_curitem();
|
||||
sub import_selusr($);
|
||||
|
||||
initenv(-restricted => 1,
|
||||
-this_table => "userpref",
|
||||
-dbi_lock => {"userpref" => LOCK_EX,
|
||||
"users" => LOCK_SH},
|
||||
-lastmod => 1,
|
||||
-page_param => {"keywords" => N_("user preference")});
|
||||
|
||||
main;
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
my ($error, $success, $processor);
|
||||
|
||||
# If the request is a GET query
|
||||
if ($ENV{"REQUEST_METHOD"} ne "POST") {
|
||||
$error = check_get;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
html_page $error;
|
||||
|
||||
# Display the page
|
||||
} else {
|
||||
html_page retrieve_status;
|
||||
}
|
||||
|
||||
# If a form was POSTed from the client
|
||||
} else {
|
||||
$error = check_post;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
error_redirect $error;
|
||||
|
||||
# Else, save the data
|
||||
} else {
|
||||
$processor = new Selima::Processor::UserPref($POST);
|
||||
$success = $processor->process;
|
||||
success_redirect $success;
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# check_get: Check the GET arguments
|
||||
sub check_get() {
|
||||
local ($_, %_);
|
||||
my $error;
|
||||
|
||||
# A form is requested
|
||||
if (is_form) {
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Nothing to check on a new form
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
}
|
||||
# List handler handles its own error
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# check_post: Check the POSTed form
|
||||
sub check_post() {
|
||||
local ($_, %_);
|
||||
my ($checker, $error);
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::UserPref(curform);
|
||||
$checker->redir(qw(selusr delusr));
|
||||
$error = $checker->check(qw(usr domain name value));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::UserPref(curform);
|
||||
$checker->redir(qw(del selusr delusr));
|
||||
$error = $checker->check(qw(usr domain name value));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::UserPref(curform);
|
||||
$checker->redir(qw(cancel));
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# html_page: Display the page
|
||||
sub html_page($) {
|
||||
local ($_, %_);
|
||||
my ($status, $LIST, $FORM);
|
||||
$status = $_[0];
|
||||
# A form is requested
|
||||
if (is_form $status) {
|
||||
$FORM = new Selima::Form::UserPref($status);
|
||||
html_header $FORM->{"title"};
|
||||
html_errmsg $status;
|
||||
$FORM->html;
|
||||
html_footer;
|
||||
|
||||
# List the available items
|
||||
} else {
|
||||
$LIST = new Selima::List::UserPref;
|
||||
html_header $LIST->{"title"}, $LIST->page_param;
|
||||
html_errmsg $status;
|
||||
$LIST->html;
|
||||
html_footer;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
##################################
|
||||
# Subroutines to manage the data #
|
||||
##################################
|
||||
# fetch_curitem: Fetch the current item
|
||||
sub fetch_curitem() {
|
||||
local ($_, %_);
|
||||
my ($sn, $FORM);
|
||||
|
||||
# Return if fetched before
|
||||
return if scalar(keys %CURRENT) > 0;
|
||||
|
||||
# Obtain the current form
|
||||
$FORM = curform;
|
||||
# No item specified
|
||||
return {"msg"=>N_("Please select the user preference."),
|
||||
"isform"=>0}
|
||||
if !defined $FORM->param("sn");
|
||||
$sn = $FORM->param("sn");
|
||||
|
||||
# Find the record
|
||||
%CURRENT = fetchrec $sn, $THIS_TABLE;
|
||||
# If this record exist
|
||||
return {"msg"=>N_("This user preference does not exist anymore. Please select another one."),
|
||||
"isform"=>0}
|
||||
if scalar(keys %CURRENT) == 0;
|
||||
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# import_selusr: Import the selected user into the retrieved form
|
||||
sub import_selusr($) {
|
||||
local ($_, %_);
|
||||
my $FORM;
|
||||
$FORM = $_[0];
|
||||
if ( defined $GET->param("selsn")
|
||||
&& check_sn_in ${$GET->param_fetch("selsn")}[0], "users") {
|
||||
$FORM->param("usr", $GET->param("selsn"));
|
||||
$FORM->param("everyone", "false");
|
||||
}
|
||||
return;
|
||||
}
|
||||
273
htdocs/emandy/magicat/cgi-bin/users.cgi
Executable file
273
htdocs/emandy/magicat/cgi-bin/users.cgi
Executable file
@@ -0,0 +1,273 @@
|
||||
#! /usr/bin/perl -w
|
||||
# Mandy Wu's Website
|
||||
# users.cgi: The user account administration.
|
||||
|
||||
# Copyright (c) 2006-2021 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-11-14
|
||||
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||
use Selima::emandy;
|
||||
local $SIG{"__DIE__"} = \&http_500;
|
||||
my $d = new Selima::Destroy;
|
||||
# Prototype declaration
|
||||
sub main();
|
||||
sub check_get();
|
||||
sub check_post();
|
||||
sub html_page($);
|
||||
sub fetch_curitem();
|
||||
|
||||
initenv(-this_table => "users",
|
||||
-dbi_lock => {"users" => LOCK_EX,
|
||||
"usermem" => LOCK_EX,
|
||||
"userpref" => LOCK_EX,
|
||||
"groupmem" => LOCK_SH,
|
||||
"groups" => LOCK_SH},
|
||||
-lastmod => 1,
|
||||
-page_param => {"keywords" => N_("users")});
|
||||
|
||||
main;
|
||||
exit 0;
|
||||
|
||||
sub main() {
|
||||
local ($_, %_);
|
||||
my ($error, $success, $processor);
|
||||
|
||||
# If the request is a GET query
|
||||
if ($ENV{"REQUEST_METHOD"} ne "POST") {
|
||||
$error = check_get;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
html_page $error;
|
||||
|
||||
# Display the page
|
||||
} else {
|
||||
html_page retrieve_status;
|
||||
}
|
||||
|
||||
# If a form was POSTed from the client
|
||||
} else {
|
||||
$error = check_post;
|
||||
# If an error occurs
|
||||
if (defined $error) {
|
||||
# Password not saved
|
||||
$POST->delete("passwd", "passwd2");
|
||||
error_redirect $error;
|
||||
|
||||
# Else, save the data
|
||||
} else {
|
||||
$processor = new Selima::Processor::User($POST);
|
||||
$success = $processor->process;
|
||||
# Password not saved
|
||||
$POST->delete("passwd", "passwd2");
|
||||
success_redirect $success;
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# check_get: Check the GET arguments
|
||||
sub check_get() {
|
||||
local ($_, %_);
|
||||
my ($error, $FORM, $sn);
|
||||
|
||||
# A form is requested
|
||||
if (is_form) {
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Check the privilege to manage this table
|
||||
unauth if !is_script_permitted;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check the privilege to manage this table
|
||||
$FORM = curform;
|
||||
$sn = defined $FORM->param("sn")? $FORM->param("sn"): -1;
|
||||
unauth unless defined get_login_sn;
|
||||
unauth unless is_script_permitted || $sn == get_login_sn;
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check the privilege to manage this table
|
||||
$FORM = curform;
|
||||
$sn = defined $FORM->param("sn")? $FORM->param("sn"): -1;
|
||||
unauth unless defined get_login_sn;
|
||||
unauth unless is_script_permitted;
|
||||
unauth if !is_su && (is_su $sn || $sn == get_login_sn);
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
# Check the privilege to manage this table
|
||||
unauth unless is_script_permitted;
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
|
||||
# List the available items
|
||||
} else {
|
||||
# Check the privilege to manage this table
|
||||
unauth unless is_script_permitted;
|
||||
# List handler handles its own error
|
||||
}
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# check_post: Check the POSTed form
|
||||
sub check_post() {
|
||||
local ($_, %_);
|
||||
my ($checker, $error, $FORM, $sn);
|
||||
$_ = form_type;
|
||||
# A form to create a new item
|
||||
if ($_ eq "new") {
|
||||
# Check the privilege to manage this table
|
||||
unauth unless is_script_permitted;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::User(curform);
|
||||
$error = $checker->check(qw(id passwd name supgroup));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($_ eq "cur") {
|
||||
# Check the privilege to manage this table
|
||||
$FORM = curform;
|
||||
$sn = defined $FORM->param("sn")? $FORM->param("sn"): -1;
|
||||
unauth unless defined get_login_sn;
|
||||
unauth unless is_script_permitted || $sn == get_login_sn;
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::User(curform);
|
||||
$checker->redir(qw(del));
|
||||
$error = $checker->check(qw(id passwd name supgroup));
|
||||
return $error if defined $error;
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($_ eq "del") {
|
||||
# Check the privilege to manage this table
|
||||
$FORM = curform;
|
||||
$sn = defined $FORM->param("sn")? $FORM->param("sn"): -1;
|
||||
unauth unless defined get_login_sn;
|
||||
unauth unless is_script_permitted;
|
||||
unauth if !is_su && (is_su $sn || $sn == get_login_sn);
|
||||
# Check at fetch_curitem()
|
||||
$error = fetch_curitem;
|
||||
return $error if defined $error;;
|
||||
# Run the checker
|
||||
$checker = new Selima::Checker::User(curform);
|
||||
$checker->redir(qw(cancel));
|
||||
|
||||
# Not a valid form
|
||||
} else {
|
||||
# Check the privilege to manage this table
|
||||
unauth unless is_script_permitted;
|
||||
return {"msg"=>N_("Incorrect form: [_1]."),
|
||||
"margs"=>[$_],
|
||||
"isform"=>0};
|
||||
}
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# html_page: Display the page
|
||||
sub html_page($) {
|
||||
local ($_, %_);
|
||||
my ($status, $LIST, $FORM);
|
||||
$status = $_[0];
|
||||
# A form is requested
|
||||
if (is_form $status) {
|
||||
$FORM = new Selima::Form::User($status);
|
||||
html_header $FORM->{"title"};
|
||||
html_errmsg $status;
|
||||
$FORM->html;
|
||||
html_footer;
|
||||
|
||||
# List the available items
|
||||
} else {
|
||||
$LIST = new Selima::List::Users;
|
||||
html_header $LIST->{"title"}, $LIST->page_param;
|
||||
html_errmsg $status;
|
||||
$LIST->html;
|
||||
html_footer;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
##################################
|
||||
# Subroutines to manage the data #
|
||||
##################################
|
||||
# fetch_curitem: Fetch the current item
|
||||
sub fetch_curitem() {
|
||||
local ($_, %_);
|
||||
my ($sn, $FORM, $sth, $sql, $row);
|
||||
|
||||
# Return if fetched before
|
||||
return if scalar(keys %CURRENT) > 0;
|
||||
|
||||
# Obtain the current form
|
||||
$FORM = curform;
|
||||
# No item specified
|
||||
return {"msg"=>N_("Please select the user."),
|
||||
"isform"=>0}
|
||||
if !defined $FORM->param("sn");
|
||||
$sn = $FORM->param("sn");
|
||||
|
||||
# Find the record
|
||||
%CURRENT = fetchrec $sn, $THIS_TABLE;
|
||||
# If this record exist
|
||||
return {"msg"=>N_("This user does not exist anymore. Please select another one."),
|
||||
"isform"=>0}
|
||||
if scalar(keys %CURRENT) == 0;
|
||||
|
||||
# Obtain the belonging groups list
|
||||
$sql = "SELECT groups.sn AS sn,"
|
||||
. " groups.dsc AS title FROM usermem"
|
||||
. " INNER JOIN groups ON usermem.grp=groups.sn"
|
||||
. " WHERE usermem.member=$sn"
|
||||
. " AND groups.id!=" . $DBH->quote(SU_GROUP)
|
||||
. " AND groups.id!=" . $DBH->quote(ADMIN_GROUP)
|
||||
. " AND groups.id!=" . $DBH->quote(ALLUSERS_GROUP)
|
||||
. " ORDER BY groups.id;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$CURRENT{"supgroupcount"} = $sth->rows;
|
||||
for ($_ = 0; $_ < $CURRENT{"supgroupcount"}; $_++) {
|
||||
$row = $sth->fetchrow_hashref;
|
||||
$CURRENT{"supgroup$_"} = 1;
|
||||
$CURRENT{"supgroup$_" . "sn"} = $$row{"sn"};
|
||||
$CURRENT{"supgroup$_" . "title"} = $$row{"title"};
|
||||
}
|
||||
|
||||
# Get the admin flag
|
||||
$CURRENT{"admin"} = is_admin($sn);
|
||||
$CURRENT{"su"} = is_su($sn);
|
||||
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
72
htdocs/emandy/magicat/cv.html
Normal file
72
htdocs/emandy/magicat/cv.html
Normal file
@@ -0,0 +1,72 @@
|
||||
<!-- saved from url=(0022)http://internet.e-mail -->
|
||||
<!DOCTYPE HTML PUBLIC "W3C//DTD HTML 4.01//EN"
|
||||
http://www.w3.org/TR/html40/strict.dtd">
|
||||
<html lang="zh-tw">
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=big5">
|
||||
<meta http-equiv="Content-Style-Type" content="text/css">
|
||||
<meta http-equiv="Content-Script-Type" content="text/javascript">
|
||||
<meta name="author" content="吳燕秋">
|
||||
<meta name="generator" content="UltraEdit-32 8.00a" lang="en">
|
||||
<meta name="version" content="吳燕秋, 履歷表">
|
||||
<style type="text/css">
|
||||
body {
|
||||
padding: 1em 15%;
|
||||
}
|
||||
h1 {
|
||||
text-align:center;
|
||||
}
|
||||
img {
|
||||
float: right;
|
||||
}
|
||||
</style>
|
||||
<title>履歷表</title>
|
||||
</head>
|
||||
<body>
|
||||
<img src="http://www.emandy.idv.tw/images/mandy.jpg">
|
||||
<h1>履歷表</h1>
|
||||
<h2>個人基本資料</h2>
|
||||
<ul>
|
||||
<li>姓名: 吳燕秋</li>
|
||||
<li>籍貫: 臺灣省雲林縣</li>
|
||||
<li>生日: 1970.2.9</li>
|
||||
<li>現居地址:永和市新生路40巷1弄21號3樓</li>
|
||||
<li>Tel:(02)3233-7444（H）</li>
|
||||
<li>Cell:0953360398</li>
|
||||
<li>永久地址:高雄縣鳳山市鳳林路135號</li>
|
||||
<li>Tel:(07)7018867</li>
|
||||
</ul>
|
||||
<h2>教育程度</h2>
|
||||
<ul>
|
||||
<li>鳳山國中，1985年6月畢</li>
|
||||
<li>省立岡山高中，1988年6月畢</li>
|
||||
<li>中國文化大學史學系，1993年6月畢</li>
|
||||
<li>輔仁大學歷史系碩士班，1998年6月畢</li>
|
||||
</ul>
|
||||
<h2>工作經歷</h2>
|
||||
<ul>
|
||||
<li>百英資訊公司業務助理（1994年）</li>
|
||||
<li>中國社會文化研究中心專員（1996-1997年）</li>
|
||||
<li>臺北市立士林高商代課教師（1997年）</li>
|
||||
<li>中國海事專科學校兼任講師（1998-1999年）</li>
|
||||
<li>國立空中大學面授講師（1998-迄今）</li>
|
||||
<li>華杏出版公司辭典助編（1998年）</li>
|
||||
<li>台灣大學婦女研究室助理研究員（1998-1999年）</li>
|
||||
<li>蕃薯藤女性入口網站hercafe的<a href="http://hercafe.yam.com/hertalk/womanwoman/">「女話」</a>專欄作家</li>
|
||||
<li>清華大學歷史研究所傅大為教授國科會計畫<a href="http://rpgs1.isa.nthu.edu.tw/~twmed/">【當代台灣人文網際網路--醫療與身體：網路建構及對20世紀台灣「現代性」之反省】</a>研究助理（1999年10月-2000年9月底）</li>
|
||||
<li>中研院科學史通訊執行編輯</li>
|
||||
</ul>
|
||||
|
||||
<h2>期刊、網站</h2>
|
||||
<ul>
|
||||
<li><a href="http://www.wov.idv.tw/">女聲電子報</a>編輯</li>
|
||||
<li><a href="http://www.emandy.idv.tw/htc/">歷史：理論與文化</a>編輯委員及Webmaster</li>
|
||||
</ul>
|
||||
<h2>專長</h2>
|
||||
<ul>
|
||||
<li>文字撰稿</li>
|
||||
<li>電腦文書資料處理</li>
|
||||
<li>籌辦活動</li>
|
||||
</ul>
|
||||
</body>
|
||||
</html>
|
||||
31
htdocs/emandy/magicat/include/footer.html
Normal file
31
htdocs/emandy/magicat/include/footer.html
Normal file
@@ -0,0 +1,31 @@
|
||||
<hr />
|
||||
<div id="footer" class="footer" title="頁尾區">
|
||||
<div>
|
||||
<a href="http://www.w3.org/Style/CSS/Buttons/"
|
||||
title="CSS 樣式表說明" hreflang="en"><img
|
||||
src="/images/w3c/mwcts" alt="以 CSS 樣式表製作" /></a>|<a
|
||||
href="http://html-validator.imacat.idv.tw/check/referer"
|
||||
title="本頁的 HTML 驗證結果" hreflang="en"><img
|
||||
src="/images/w3c/vxhtml11" alt="XHTML 1.1 正確！" /></a>|<a
|
||||
href="http://jigsaw.w3.org/css-validator/check/referer"
|
||||
title="本頁的 CSS 驗證結果" hreflang="en"><img
|
||||
src="/images/w3c/vcss" alt="CSS 正確！" /></a>|<a
|
||||
href="http://www.w3.org/WAI/WCAG1AAA-Conformance"
|
||||
title="無障礙三 A 級標準說明" hreflang="en"><img
|
||||
src="/images/w3c/wcag1AAA"
|
||||
alt="W3C 無障礙網頁規範 1.0 三 A 級標準標章" /></a>
|
||||
<p>本頁符合 <a href="http://www.w3.org/TR/xhtml11/" hreflang="en"><abbr
|
||||
title="Extensible HyperText Markup Language">XHTML</abbr> 1.1</a> /
|
||||
<a href="http://www.w3.org/TR/CSS21/" hreflang="en"><abbr
|
||||
title="Cascading Style Sheets">CSS</abbr> 2.1</a> /
|
||||
<a href="http://www.w3.org/TR/WAI-WEBCONTENT/"
|
||||
hreflang="en">無障礙網頁規範 1.0</a> 三 A 級標準</p>
|
||||
</div>
|
||||
|
||||
<!--selima:perl-->
|
||||
|
||||
<div>
|
||||
<p>版權所有 © <!--selima:copyyear--> 小招</p>
|
||||
</div>
|
||||
|
||||
</div>
|
||||
12
htdocs/emandy/magicat/include/header.html
Normal file
12
htdocs/emandy/magicat/include/header.html
Normal file
@@ -0,0 +1,12 @@
|
||||
<form action="/cgi-bin/search.cgi" method="get" accept-charset="Big5">
|
||||
<div class="navibar">
|
||||
<span><a accesskey="1" href="/">首頁</a></span> |
|
||||
<span><a href="/legend/">傳奇</a></span> |
|
||||
<span><a href="/links/">相關連結</a></span> |
|
||||
<span><a href="mailto:mandy@mail.emandy.idv.tw"><em><acronym title="electronic mail">E-mail</acronym></em></a></span> |
|
||||
<label for="navquery">檢索：</label><input
|
||||
id="navquery" class="text" type="text" name="query" value="" /><input
|
||||
type="hidden" name="charset" value="Big5" /><input
|
||||
type="submit" value="搜尋" />
|
||||
</div>
|
||||
</form>
|
||||
1
htdocs/emandy/magicat/index.html.html
Symbolic link
1
htdocs/emandy/magicat/index.html.html
Symbolic link
@@ -0,0 +1 @@
|
||||
index.html.xhtml
|
||||
132
htdocs/emandy/magicat/index.html.xhtml
Normal file
132
htdocs/emandy/magicat/index.html.xhtml
Normal file
@@ -0,0 +1,132 @@
|
||||
<?xml version="1.0" encoding="UTF-8" ?>
|
||||
<!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="zh-tw">
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="application/xhtml+xml; charset=UTF-8" />
|
||||
<meta http-equiv="Content-Style-Type" content="text/css" />
|
||||
<meta http-equiv="Content-Script-Type" content="text/javascript" />
|
||||
<meta name="author" content="小招" />
|
||||
<meta name="copyright" content="© 2006-2018 小招。小招保有所有權利。" />
|
||||
<meta name="keywords" content="網站管理, 內容管理" />
|
||||
<link rel="start" type="application/xhtml+xml" href=".." />
|
||||
<link rel="author" type="application/xhtml+xml" href="mailto:htc@mail.emandy.idv.tw" />
|
||||
<link rel="up" type="application/xhtml+xml" href=".." />
|
||||
<link rel="stylesheet" type="text/css" href="../stylesheets/common.css" />
|
||||
<link rel="shortcut icon" type="image/x-icon" href="../favicon.ico" />
|
||||
<title>梅姬妳好 *^_^*</title>
|
||||
</head>
|
||||
<body>
|
||||
|
||||
<div id="topofpage" class="skiptobody">
|
||||
<a accesskey="2" href="#body">跳到網頁內文區。</a>
|
||||
</div>
|
||||
|
||||
|
||||
<div id="nav" class="nav" title="導覽連結區">
|
||||
<div class="accessguide"><a accesskey="L"
|
||||
href="#nav" title="導覽連結區">:::</a></div>
|
||||
|
||||
<form action="../cgi-bin/search.cgi" method="get" accept-charset="UTF-8">
|
||||
<div class="navibar">
|
||||
<span><a accesskey="1" href="..">首頁</a></span> |
|
||||
<span><a href="../legend/">傳奇</a></span> |
|
||||
<span><a href="../links/">相關連結</a></span> |
|
||||
<span><a href="mailto:htc@mail.emandy.idv.tw"><em><acronym title="electronic mail">E-mail</acronym></em></a></span> |
|
||||
<label for="navquery">檢索：</label><input
|
||||
id="navquery" class="text" type="text" name="query" value="" /><input
|
||||
type="hidden" name="charset" value="UTF-8" /><input
|
||||
type="submit" value="搜尋" />
|
||||
</div>
|
||||
</form>
|
||||
</div>
|
||||
<hr />
|
||||
|
||||
<div id="body" class="body" title="網頁內文區">
|
||||
<div class="accessguide"><a accesskey="C"
|
||||
href="#body" title="網頁內文區">:::</a></div>
|
||||
|
||||
<h1 class="title">我是梅姬，請多多指教 *^_^*</h1>
|
||||
|
||||
<div class="intro">
|
||||
<p>妳好，我是梅姬，是小招網站的守護精靈。妳要怎麼設定網站，請儘管吩咐我喔～！</p>
|
||||
</div>
|
||||
|
||||
<h2>管理網站</h2>
|
||||
|
||||
<ul class="toc">
|
||||
<li><a href="cgi-bin/legend.cgi">傳奇</a></li>
|
||||
<li><a href="cgi-bin/books.cgi">書目</a></li>
|
||||
<li><a href="cgi-bin/material.cgi">史料</a></li>
|
||||
<li><a href="cgi-bin/mtrltype.cgi">史料類型</a></li>
|
||||
<li><a href="cgi-bin/pages.cgi">網頁</a></li>
|
||||
<li><a href="cgi-bin/links.cgi">連結</a></li>
|
||||
<li><a href="cgi-bin/linkcat.cgi">連結分類</a></li>
|
||||
<li><a href="cgi-bin/linkcatz.cgi">連結分類表</a></li>
|
||||
</ul>
|
||||
|
||||
<h2>管理帳號</h2>
|
||||
|
||||
<ul class="toc">
|
||||
<li><a href="cgi-bin/users.cgi">帳號</a></li>
|
||||
<li><a href="cgi-bin/groups.cgi">群組</a></li>
|
||||
<li><a href="cgi-bin/usermem.cgi">使用者成員</a></li>
|
||||
<li><a href="cgi-bin/groupmem.cgi">群組成員</a></li>
|
||||
<li><a href="cgi-bin/userpref.cgi">使用者偏好</a></li>
|
||||
<li><a href="cgi-bin/scptpriv.cgi">程式權限</a></li>
|
||||
</ul>
|
||||
|
||||
<h2>台灣的士青代管帳</h2>
|
||||
|
||||
<ul class="toc">
|
||||
<li><a href="https://rinse.wov.idv.tw/emandy/magicat/cgi-bin/acctreps.cgi">報表</a></li>
|
||||
<li><a href="https://rinse.wov.idv.tw/emandy/magicat/cgi-bin/accttrx.cgi">傳票</a></li>
|
||||
<li><a href="https://rinse.wov.idv.tw/emandy/magicat/cgi-bin/acctsubj.cgi">科目</a></li>
|
||||
<li><a href="https://rinse.wov.idv.tw/emandy/magicat/cgi-bin/acctrecs.cgi">分錄</a></li>
|
||||
</ul>
|
||||
|
||||
<h2>其她</h2>
|
||||
|
||||
<ul class="toc">
|
||||
<li><a href="cgi-bin/actlog.cgi">活動日誌</a></li>
|
||||
<li><a href="cgi-bin/rebuild.cgi">重製網頁</a></li>
|
||||
<li><a href="analog/">訪客統計</a></li>
|
||||
<li><a href="cgi-bin/test.cgi">測試程式</a></li>
|
||||
</ul>
|
||||
|
||||
</div>
|
||||
|
||||
|
||||
<hr />
|
||||
<div id="footer" class="footer" title="頁尾區">
|
||||
<div>
|
||||
<a href="http://www.w3.org/Style/CSS/Buttons/"
|
||||
title="CSS 樣式表說明" hreflang="en"><img
|
||||
src="../images/w3c/mwcts" alt="以 CSS 樣式表製作" /></a>|<a
|
||||
href="http://html-validator.imacat.idv.tw/check/referer"
|
||||
title="本頁的 HTML 驗證結果" hreflang="en"><img
|
||||
src="../images/w3c/vxhtml11" alt="XHTML 1.1 正確！" /></a>|<a
|
||||
href="http://jigsaw.w3.org/css-validator/check/referer"
|
||||
title="本頁的 CSS 驗證結果" hreflang="en"><img
|
||||
src="../images/w3c/vcss" alt="CSS 正確！" /></a>|<a
|
||||
href="http://www.w3.org/WAI/WCAG1AAA-Conformance"
|
||||
title="無障礙三 A 級標準說明" hreflang="en"><img
|
||||
src="../images/w3c/wcag1AAA"
|
||||
alt="W3C 無障礙網頁規範 1.0 三 A 級標準標章" /></a>
|
||||
<p>本頁符合 <a href="http://www.w3.org/TR/xhtml11/" hreflang="en"><abbr
|
||||
title="Extensible HyperText Markup Language">XHTML</abbr> 1.1</a> /
|
||||
<a href="http://www.w3.org/TR/CSS21/" hreflang="en"><abbr
|
||||
title="Cascading Style Sheets">CSS</abbr> 2.1</a> /
|
||||
<a href="http://www.w3.org/TR/WAI-WEBCONTENT/"
|
||||
hreflang="en">無障礙網頁規範 1.0</a> 三 A 級標準</p>
|
||||
|
||||
</div>
|
||||
|
||||
<div>
|
||||
<p>版權所有 © 2006-2018 小招</p>
|
||||
</div>
|
||||
|
||||
</div>
|
||||
|
||||
</body>
|
||||
</html>
|
||||
1
htdocs/emandy/magicat/lib/acctsubj.sql
Symbolic link
1
htdocs/emandy/magicat/lib/acctsubj.sql
Symbolic link
@@ -0,0 +1 @@
|
||||
../../../wov/magicat/lib/acctsubj.sql
|
||||
1404
htdocs/emandy/magicat/lib/emandy.sql
Normal file
1404
htdocs/emandy/magicat/lib/emandy.sql
Normal file
File diff suppressed because it is too large
Load Diff
70
htdocs/emandy/magicat/lib/perl5/Selima/emandy.pm
Normal file
70
htdocs/emandy/magicat/lib/perl5/Selima/emandy.pm
Normal file
@@ -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;
|
||||
203
htdocs/emandy/magicat/lib/perl5/Selima/emandy/Checker/Book.pm
Normal file
203
htdocs/emandy/magicat/lib/perl5/Selima/emandy/Checker/Book.pm
Normal file
@@ -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;
|
||||
@@ -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;
|
||||
@@ -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;
|
||||
@@ -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;
|
||||
92
htdocs/emandy/magicat/lib/perl5/Selima/emandy/Config.pm
Normal file
92
htdocs/emandy/magicat/lib/perl5/Selima/emandy/Config.pm
Normal file
@@ -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 = "© <!--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;
|
||||
53
htdocs/emandy/magicat/lib/perl5/Selima/emandy/DataVars.pm
Normal file
53
htdocs/emandy/magicat/lib/perl5/Selima/emandy/DataVars.pm
Normal file
@@ -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;
|
||||
129
htdocs/emandy/magicat/lib/perl5/Selima/emandy/Form/Book.pm
Normal file
129
htdocs/emandy/magicat/lib/perl5/Selima/emandy/Form/Book.pm
Normal file
@@ -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;
|
||||
99
htdocs/emandy/magicat/lib/perl5/Selima/emandy/Form/Legend.pm
Normal file
99
htdocs/emandy/magicat/lib/perl5/Selima/emandy/Form/Legend.pm
Normal file
@@ -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;
|
||||
112
htdocs/emandy/magicat/lib/perl5/Selima/emandy/Form/Material.pm
Normal file
112
htdocs/emandy/magicat/lib/perl5/Selima/emandy/Form/Material.pm
Normal file
@@ -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;
|
||||
@@ -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;
|
||||
752
htdocs/emandy/magicat/lib/perl5/Selima/emandy/HTML.pm
Normal file
752
htdocs/emandy/magicat/lib/perl5/Selima/emandy/HTML.pm
Normal file
@@ -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 "©".
|
||||
$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;
|
||||
93
htdocs/emandy/magicat/lib/perl5/Selima/emandy/Items.pm
Normal file
93
htdocs/emandy/magicat/lib/perl5/Selima/emandy/Items.pm
Normal file
@@ -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;
|
||||
38
htdocs/emandy/magicat/lib/perl5/Selima/emandy/L10N.pm
Normal file
38
htdocs/emandy/magicat/lib/perl5/Selima/emandy/L10N.pm
Normal file
@@ -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;
|
||||
113
htdocs/emandy/magicat/lib/perl5/Selima/emandy/List/Books.pm
Normal file
113
htdocs/emandy/magicat/lib/perl5/Selima/emandy/List/Books.pm
Normal file
@@ -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;
|
||||
@@ -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;
|
||||
@@ -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;
|
||||
100
htdocs/emandy/magicat/lib/perl5/Selima/emandy/List/Legend.pm
Normal file
100
htdocs/emandy/magicat/lib/perl5/Selima/emandy/List/Legend.pm
Normal file
@@ -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;
|
||||
@@ -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;
|
||||
100
htdocs/emandy/magicat/lib/perl5/Selima/emandy/List/Material.pm
Normal file
100
htdocs/emandy/magicat/lib/perl5/Selima/emandy/List/Material.pm
Normal file
@@ -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;
|
||||
@@ -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;
|
||||
179
htdocs/emandy/magicat/lib/perl5/Selima/emandy/List/Search.pm
Normal file
179
htdocs/emandy/magicat/lib/perl5/Selima/emandy/List/Search.pm
Normal file
@@ -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;
|
||||
121
htdocs/emandy/magicat/lib/perl5/Selima/emandy/Processor/Book.pm
Normal file
121
htdocs/emandy/magicat/lib/perl5/Selima/emandy/Processor/Book.pm
Normal file
@@ -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;
|
||||
@@ -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;
|
||||
@@ -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;
|
||||
@@ -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;
|
||||
436
htdocs/emandy/magicat/lib/perl5/Selima/emandy/Rebuild.pm
Normal file
436
htdocs/emandy/magicat/lib/perl5/Selima/emandy/Rebuild.pm
Normal file
@@ -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;
|
||||
BIN
htdocs/emandy/magicat/locale/zh_TW/LC_MESSAGES/emandy.mo
Normal file
BIN
htdocs/emandy/magicat/locale/zh_TW/LC_MESSAGES/emandy.mo
Normal file
Binary file not shown.
45
htdocs/emandy/magicat/po/Makefile
Normal file
45
htdocs/emandy/magicat/po/Makefile
Normal file
@@ -0,0 +1,45 @@
|
||||
# Possible make targets:
|
||||
# all: Compile the PO files and copy the binary MO files
|
||||
# into the appropriate directories
|
||||
# xgettext: Obtain the newest PO template file $(PACKAGE).pot
|
||||
# from the source programs
|
||||
# msgmerge: Compare the template $(PACKAGE).pot and the existing
|
||||
# PO files and get the newest POX files to work with.
|
||||
|
||||
|
||||
PACKAGE = emandy
|
||||
ALLLINGUAS = zh_TW
|
||||
PKGROOT = ../..
|
||||
PODIR = magicat/po
|
||||
LOCALEDIR = $(PKGROOT)/magicat/locale
|
||||
CATEGORY = LC_MESSAGES
|
||||
#PROGRAMS = cgi-bin/*.cgi magicat/cgi-bin/*.cgi magicat/lib/perl5/*/*.pm magicat/lib/perl5/*/*/*.pm magicat/lib/perl5/*/*/*/*.pm magicat/lib/perl5/*/*/*/*/*.pm
|
||||
PROGRAMS = magicat/cgi-bin/*.cgi magicat/lib/perl5/*/*.pm magicat/lib/perl5/*/*/*.pm magicat/lib/perl5/*/*/*/*.pm magicat/lib/perl5/*/*/*/*/*.pm
|
||||
|
||||
all:
|
||||
for ln in $(ALLLINGUAS); do \
|
||||
msgfmt $$ln.po -o $$ln.gmo; \
|
||||
test -d $(LOCALEDIR) || \
|
||||
(rm -rf $(LOCALEDIR) && \
|
||||
mkdir $(LOCALEDIR)); \
|
||||
test -d $(LOCALEDIR)/$$ln || \
|
||||
(rm -rf $(LOCALEDIR)/$$ln && \
|
||||
mkdir $(LOCALEDIR)/$$ln); \
|
||||
test -d $(LOCALEDIR)/$$ln/$(CATEGORY) || \
|
||||
(rm -rf $(LOCALEDIR)/$$ln/$(CATEGORY) && \
|
||||
mkdir $(LOCALEDIR)/$$ln/$(CATEGORY)); \
|
||||
rm -f $(LOCALEDIR)/$$ln/$(CATEGORY)/$(PACKAGE).mo; \
|
||||
cp $$ln.gmo $(LOCALEDIR)/$$ln/$(CATEGORY)/$(PACKAGE).mo; \
|
||||
done
|
||||
|
||||
xgettext:
|
||||
cd $(PKGROOT); \
|
||||
xgettext --keyword=__ --keyword=N_ -p $(PODIR)/ -o $(PACKAGE).pot \
|
||||
--language=c $(PROGRAMS); \
|
||||
cd $(PODIR); \
|
||||
for ln in $(ALLLINGUAS); do \
|
||||
msgmerge $$ln.po $(PACKAGE).pot > $$ln.pox; \
|
||||
done
|
||||
|
||||
clean:
|
||||
rm -f *.gmo
|
||||
1069
htdocs/emandy/magicat/po/emandy.pot
Normal file
1069
htdocs/emandy/magicat/po/emandy.pot
Normal file
File diff suppressed because it is too large
Load Diff
BIN
htdocs/emandy/magicat/po/zh_TW.gmo
Normal file
BIN
htdocs/emandy/magicat/po/zh_TW.gmo
Normal file
Binary file not shown.
1078
htdocs/emandy/magicat/po/zh_TW.po
Normal file
1078
htdocs/emandy/magicat/po/zh_TW.po
Normal file
File diff suppressed because it is too large
Load Diff
1078
htdocs/emandy/magicat/po/zh_TW.pox
Normal file
1078
htdocs/emandy/magicat/po/zh_TW.pox
Normal file
File diff suppressed because it is too large
Load Diff
83
htdocs/emandy/magicat/soc-cv.html
Normal file
83
htdocs/emandy/magicat/soc-cv.html
Normal file
@@ -0,0 +1,83 @@
|
||||
<!-- saved from url=(0022)http://internet.e-mail -->
|
||||
<!DOCTYPE HTML PUBLIC "W3C//DTD HTML 4.01//EN"
|
||||
http://www.w3.org/TR/html40/strict.dtd">
|
||||
<html lang="zh-tw">
|
||||
<head>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=big5">
|
||||
<meta http-equiv="Content-Style-Type" content="text/css">
|
||||
<meta http-equiv="Content-Script-Type" content="text/javascript">
|
||||
<meta name="author" content="吳燕秋">
|
||||
<meta name="generator" content="UltraEdit-32 8.00a" lang="en">
|
||||
<meta name="version" content="吳燕秋, 履歷表">
|
||||
<style type="text/css">
|
||||
body {
|
||||
padding: 1em 15%;
|
||||
}
|
||||
h1 {
|
||||
text-align:center;
|
||||
}
|
||||
img {
|
||||
float: right;
|
||||
}
|
||||
</style>
|
||||
<title>履歷表</title>
|
||||
</head>
|
||||
<body>
|
||||
<img src="http://www.emandy.idv.tw/images/mandy.jpg">
|
||||
<h1>履歷表</h1>
|
||||
<h2>個人基本資料</h2>
|
||||
<ul>
|
||||
<li>姓名: 吳燕秋</li>
|
||||
<li>籍貫: 臺灣省雲林縣</li>
|
||||
<li>生日: 1970.2.9</li>
|
||||
<li>現居地址:永和市新生路40巷1弄21號3樓</li>
|
||||
<li>Tel:(02)3233-7444（H）</li>
|
||||
<li>Cell:0953360398</li>
|
||||
<li>永久地址:高雄縣鳳山市鳳林路135號</li>
|
||||
<li>Tel:(07)7018867</li>
|
||||
</ul>
|
||||
<h2>教育程度</h2>
|
||||
<ul>
|
||||
<li>鳳山國中，1985年6月畢</li>
|
||||
<li>省立岡山高中，1988年6月畢</li>
|
||||
<li>中國文化大學史學系，1993年6月畢</li>
|
||||
<li>輔仁大學歷史系碩士班，1998年6月畢</li>
|
||||
</ul>
|
||||
<h2>社團參與</h2>
|
||||
<ul>
|
||||
<li>文化大學：當代思潮社</li>
|
||||
<li>輔仁大學：女研社</li>
|
||||
</ul>
|
||||
<h2>工作經歷</h2>
|
||||
<ul>
|
||||
<li>百英資訊公司業務助理（1994年）</li>
|
||||
<li>中國社會文化研究中心專員（1996-1997年）</li>
|
||||
<li>臺北市立士林高商代課教師（1997年）</li>
|
||||
<li>中國海事專科學校兼任講師（1998-1999年）</li>
|
||||
<li>國立空中大學面授講師（1998-迄今）</li>
|
||||
<li>華杏出版公司辭典助編（1998年）</li>
|
||||
<li>台灣大學婦女研究室助理研究員（1998-1999年）</li>
|
||||
<li>蕃薯藤女性入口網站hercafe的<a href="http://hercafe.yam.com/hertalk/womanwoman/">「女話」</a>專欄作家</li>
|
||||
<li>清華大學歷史研究所傅大為教授國科會計畫<a href="http://rpgs1.isa.nthu.edu.tw/~twmed/">【當代台灣人文網際網路--醫療與身體：網路建構及對20世紀台灣「現代性」之反省】</a>研究助理（1999年10月-2000年9月底）</li>
|
||||
<li>中研院科學史通訊執行編輯</li>
|
||||
</ul>
|
||||
|
||||
<h2>期刊、網站</h2>
|
||||
<ul>
|
||||
<li><a href="http://www.wov.idv.tw/">女聲電子報</a>編輯</li>
|
||||
<li><a href="http://www.emandy.idv.tw/htc/">歷史：理論與文化</a>編輯委員及Webmaster</li>
|
||||
</ul>
|
||||
<h2>學術作品</h2>
|
||||
<ul>
|
||||
<li>吳燕秋（1998），〈從政治參與看德國婦女運動，1891-1918〉，輔仁大學歷史研究所碩士論文。</li>
|
||||
<li>張玨、吳燕秋（1999），〈台灣婦女研究與兩性平等教育〉，發表於1999年由台大婦女研究室主辦「兩性平等教育國際研討會」。</li>
|
||||
<li>張玨、吳燕秋、胡婷婷（1999），〈困境與突圍：從台大婦女研究室談婦研機構的建制化〉，發表於1999年清大兩性與社會研究室主辦「亞洲婦女研究學程研討會」。</li>
|
||||
</ul>
|
||||
<h2>專長</h2>
|
||||
<ul>
|
||||
<li>文字撰稿</li>
|
||||
<li>電腦文書資料處理</li>
|
||||
<li>籌辦活動</li>
|
||||
</ul>
|
||||
</body>
|
||||
</html>
|
||||
Reference in New Issue
Block a user