Initial commit.
This commit is contained in:
55
htdocs/emandy/cgi-bin/search.cgi
Executable file
55
htdocs/emandy/cgi-bin/search.cgi
Executable file
@@ -0,0 +1,55 @@
|
|||||||
|
#! /usr/bin/perl -w
|
||||||
|
# Mandy Wu's Website
|
||||||
|
# search.cgi: The web site full-text search.
|
||||||
|
|
||||||
|
# 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();
|
||||||
|
|
||||||
|
use Fcntl qw(:seek);
|
||||||
|
|
||||||
|
initenv(-allowed => [qw(GET HEAD)],
|
||||||
|
-session => 0,
|
||||||
|
-dbi_lock => {"pages" => LOCK_SH,
|
||||||
|
"legend" => LOCK_SH,
|
||||||
|
"links" => LOCK_SH},
|
||||||
|
-lastmod => 1,
|
||||||
|
-page_param => {"keywords" => N_("search, query, full text search"),
|
||||||
|
"class" => "search"});
|
||||||
|
|
||||||
|
main;
|
||||||
|
exit 0;
|
||||||
|
|
||||||
|
sub main() {
|
||||||
|
local ($_, %_);
|
||||||
|
my $LIST;
|
||||||
|
# List handler handles its own error
|
||||||
|
$LIST = new Selima::emandy::List::Search;
|
||||||
|
html_header $LIST->{"title"}, $LIST->page_param;
|
||||||
|
$LIST->html;
|
||||||
|
html_footer;
|
||||||
|
return;
|
||||||
|
}
|
||||||
BIN
htdocs/emandy/favicon.ico
Normal file
BIN
htdocs/emandy/favicon.ico
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 2.2 KiB |
70
htdocs/emandy/home/index.html
Normal file
70
htdocs/emandy/home/index.html
Normal file
@@ -0,0 +1,70 @@
|
|||||||
|
<!DOCTYPE html>
|
||||||
|
<html xmlns="http://www.w3.org/1999/xhtml" lang="zh-tw">
|
||||||
|
<head>
|
||||||
|
<meta charset="UTF-8">
|
||||||
|
<meta name="viewport" content="width=device-width, initial-scale=1">
|
||||||
|
<meta name="author" content="依瑪貓" />
|
||||||
|
<link rel="stylesheet" href="https://stackpath.bootstrapcdn.com/bootstrap/4.3.1/css/bootstrap.min.css" integrity="sha384-ggOyR0iXCbMQv3Xipma34MD+dH/1fQ784/j6cY/iJTQUOhcWr7x9JvoRxT2MZw1T" crossorigin="anonymous">
|
||||||
|
<script src="https://code.jquery.com/jquery-3.3.1.slim.min.js" integrity="sha384-q8i/X+965DzO0rT7abK41JStQIAqVgRVzpbzo5smXKp4YfRvH+8abtTE1Pi6jizo" crossorigin="anonymous"></script>
|
||||||
|
<script src="https://cdnjs.cloudflare.com/ajax/libs/popper.js/1.14.7/umd/popper.min.js" integrity="sha384-UO2eT0CpHqdSJQ6hJty5KVphtPhzWj9WO1clHTMGa3JDZwrnQq4sF86dIHNDz0W1" crossorigin="anonymous"></script>
|
||||||
|
<script src="https://stackpath.bootstrapcdn.com/bootstrap/4.3.1/js/bootstrap.min.js" integrity="sha384-JjSmVgyd0p3pXB1rRibZUAYoIIy6OrQ6VrjIEaFf/nJGzIxFDsf4x0xIM+B07jRM" crossorigin="anonymous"></script>
|
||||||
|
<title>小招的首頁</title>
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
|
||||||
|
<div class="container">
|
||||||
|
|
||||||
|
<h1>小招的首頁</h1>
|
||||||
|
|
||||||
|
<form action="https://www.google.com/search">
|
||||||
|
<div>
|
||||||
|
<input type="text" name="q" value="" />
|
||||||
|
<input type="submit" value="Google" />
|
||||||
|
</div>
|
||||||
|
</form>
|
||||||
|
|
||||||
|
<ul class="list-group">
|
||||||
|
<li class="list-group-item">
|
||||||
|
<a class="btn btn-outline-info" role="button" href="https://clio.emandy.idv.tw/wp-admin/">克麗歐筆記</a>
|
||||||
|
<!-- <a class="btn btn-outline-info" role="button" href="../legend/">傳奇</a> -->
|
||||||
|
<a class="btn btn-outline-info" role="button" href="https://pythia.wov.idv.tw/accounting">皮媞亞</a>
|
||||||
|
<!-- <a class="btn btn-outline-info" role="button" href="https://rinse.wov.idv.tw/wov/magicat/cgi-bin/acctreps.cgi">共用帳</a> -->
|
||||||
|
</li>
|
||||||
|
<li class="list-group-item">
|
||||||
|
<a class="btn btn-outline-info" role="button" href="https://rinse.wov.idv.tw/emandy/magicat/cgi-bin/acctreps.cgi">台灣士青代管帳</a>
|
||||||
|
<a class="btn btn-outline-info" role="button" href="../magicat/">網站管理</a>
|
||||||
|
</li>
|
||||||
|
<li class="list-group-item">
|
||||||
|
<a class="btn btn-outline-info" role="button" href="https://mail.google.com/a/mail.emandy.idv.tw">Webmail信箱</a>
|
||||||
|
<!-- <a class="btn btn-outline-info" role="button" href="http://www.icq.com/icq2go/">Web ICQ</a> -->
|
||||||
|
<a class="btn btn-outline-info" role="button" href="https://www.evernote.com">Evernote</a>
|
||||||
|
</li>
|
||||||
|
<li class="list-group-item">
|
||||||
|
<a class="btn btn-outline-info" role="button" href="https://www.wov.idv.tw/">女聲</a>
|
||||||
|
<a class="btn btn-outline-info" role="button" href="https://www.wov.idv.tw/magicat/">女聲∕梅姬</a>
|
||||||
|
<!--
|
||||||
|
<a class="btn btn-outline-info" role="button" href="https://www.wov.idv.tw/mailman/admin/wov">女聲∕訂閱管理</a>
|
||||||
|
-->
|
||||||
|
</li>
|
||||||
|
<li class="list-group-item">
|
||||||
|
<a class="btn btn-outline-info" role="button" href="https://htc.emandy.idv.tw/">歷史、理論與文化</a>
|
||||||
|
<a class="btn btn-outline-info" role="button" href="https://htc.emandy.idv.tw/magicat/">歷史、理論與文化∕梅姬</a>
|
||||||
|
</li>
|
||||||
|
<!--
|
||||||
|
<li class="list-group-item">
|
||||||
|
<a class="btn btn-outline-info" role="button" href="http://clio.emandy.idv.tw/">克麗歐筆記。Clio’s Note</a>
|
||||||
|
</li>
|
||||||
|
<li class="list-group-item">
|
||||||
|
<a class="btn btn-outline-info" role="button" href="https://rinse.wov.idv.tw:631/" xml:lang="en">印表機</a>
|
||||||
|
</li>
|
||||||
|
-->
|
||||||
|
</ul>
|
||||||
|
|
||||||
|
<address>
|
||||||
|
<p>版權所有 © 2006-2020 小招</p>
|
||||||
|
</address>
|
||||||
|
|
||||||
|
</div>
|
||||||
|
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
1
htdocs/emandy/home/old/index.html.html
Symbolic link
1
htdocs/emandy/home/old/index.html.html
Symbolic link
@@ -0,0 +1 @@
|
|||||||
|
index.html.xhtml
|
||||||
166
htdocs/emandy/home/old/index.html.xhtml
Normal file
166
htdocs/emandy/home/old/index.html.xhtml
Normal file
@@ -0,0 +1,166 @@
|
|||||||
|
<?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="text/html; 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:mandy@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>
|
||||||
|
<script type="text/javascript">
|
||||||
|
function resetWindow() {
|
||||||
|
var x, y, w, h;
|
||||||
|
// 1280 x 1024
|
||||||
|
if (window.screen.width == 1280) {
|
||||||
|
x = 225;
|
||||||
|
w = 950;
|
||||||
|
// 1024 x 768
|
||||||
|
} else if (window.screen.width == 1024) {
|
||||||
|
x = 180;
|
||||||
|
w = 760;
|
||||||
|
// 800 x 600
|
||||||
|
} else if (window.screen.width == 800) {
|
||||||
|
x = 93;
|
||||||
|
w = 639;
|
||||||
|
// 640 x 480
|
||||||
|
} else if (window.screen.width == 640) {
|
||||||
|
x = 93;
|
||||||
|
w = 479;
|
||||||
|
// Non-standard resolution - return without processing
|
||||||
|
} else {
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
// 1280 x 1024
|
||||||
|
if (window.screen.height == 1024) {
|
||||||
|
y = 67;
|
||||||
|
h = 840;
|
||||||
|
// 1024 x 768
|
||||||
|
} else if (window.screen.height == 768) {
|
||||||
|
y = 50;
|
||||||
|
h = 630;
|
||||||
|
// 800 x 600
|
||||||
|
} else if (window.screen.height == 600) {
|
||||||
|
y = 25;
|
||||||
|
h = 512;
|
||||||
|
// 640 x 480
|
||||||
|
} else if (window.screen.height == 480) {
|
||||||
|
y = 14;
|
||||||
|
h = 421;
|
||||||
|
// Non-standard resolution - return without processing
|
||||||
|
} else {
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
// Netscape 4 has some difference in size specification
|
||||||
|
if (navigator.appName == "Netscape") {
|
||||||
|
if (parseInt(navigator.appVersion) == 4) {
|
||||||
|
w -= 12;
|
||||||
|
h -= 168;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if (typeof(window.resizeTo) != "undefined")
|
||||||
|
window.resizeTo(w, h);
|
||||||
|
if (typeof(window.moveTo) != "undefined")
|
||||||
|
window.moveTo(x, y);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
</script>
|
||||||
|
</head>
|
||||||
|
<body onload="resetWindow();">
|
||||||
|
|
||||||
|
<div id="body" class="body" title="網頁內文區">
|
||||||
|
<div class="accessguide"><a accesskey="C"
|
||||||
|
href="#body" title="網頁內文區">:::</a></div>
|
||||||
|
|
||||||
|
<h1>小招的首頁</h1>
|
||||||
|
|
||||||
|
<ul>
|
||||||
|
<li>
|
||||||
|
<a href="https://clio.emandy.idv.tw/wp-admin/">克麗歐筆記</a>,
|
||||||
|
<!-- <a href="../legend/">傳奇</a>, -->
|
||||||
|
<a href="https://pythia.wov.idv.tw/accounting">皮媞亞</a>,
|
||||||
|
<!-- <a href="https://rinse.wov.idv.tw/wov/magicat/cgi-bin/acctreps.cgi">共用帳</a>, -->
|
||||||
|
<a href="https://rinse.wov.idv.tw/emandy/magicat/cgi-bin/acctreps.cgi">台灣士青代管帳</a>,
|
||||||
|
<a href="../magicat/">網站管理</a>,
|
||||||
|
</li>
|
||||||
|
<li>
|
||||||
|
<a href="https://mail.google.com/a/mail.emandy.idv.tw">Webmail信箱</a>,
|
||||||
|
<a href="http://www.icq.com/icq2go/">Web ICQ</a>
|
||||||
|
</li>
|
||||||
|
<li>
|
||||||
|
<a href="https://www.wov.idv.tw/">女聲</a>,
|
||||||
|
<a href="https://www.wov.idv.tw/magicat/">女聲∕梅姬</a>,
|
||||||
|
<a href="https://www.wov.idv.tw/mailman/admin/wov">女聲∕訂閱管理</a>
|
||||||
|
</li>
|
||||||
|
<li>
|
||||||
|
<a href="https://htc.emandy.idv.tw/">歷史、理論與文化</a>,
|
||||||
|
<a href="https://htc.emandy.idv.tw/magicat/">歷史、理論與文化∕梅姬</a>
|
||||||
|
</li>
|
||||||
|
<!--
|
||||||
|
<li>
|
||||||
|
<a href="http://clio.emandy.idv.tw/">克麗歐筆記。Clio’s Note</a>
|
||||||
|
</li>
|
||||||
|
-->
|
||||||
|
<li>
|
||||||
|
<a href="https://rinse.wov.idv.tw:631/" xml:lang="en">印表機</a>
|
||||||
|
</li>
|
||||||
|
</ul>
|
||||||
|
|
||||||
|
<form action="https://www.google.com/search">
|
||||||
|
<div><input type="text" name="q" /><input
|
||||||
|
type="submit" name="btnG" value="Google" style="width: 60px;" /><input
|
||||||
|
type="submit" name="btnI" value="好手氣" style="width: 60px;" /><input
|
||||||
|
type="hidden" name="hl" value="zh-TW" /><input
|
||||||
|
type="hidden" name="ie" value="UTF-8" />
|
||||||
|
<input id="lr_zhTW" type="radio" name="lr" value="lang_zh-TW" /><label
|
||||||
|
for="lr_zhTW">中文</label>
|
||||||
|
<input id="lr_all" type="radio" name="lr" value="" checked="checked" /><label
|
||||||
|
for="lr_all">全部</label><br />
|
||||||
|
</div>
|
||||||
|
</form>
|
||||||
|
|
||||||
|
</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>
|
||||||
BIN
htdocs/emandy/images/icon.gif
Normal file
BIN
htdocs/emandy/images/icon.gif
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 674 B |
BIN
htdocs/emandy/images/mandy.jpg
Normal file
BIN
htdocs/emandy/images/mandy.jpg
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 5.1 KiB |
BIN
htdocs/emandy/images/modperl.png
Normal file
BIN
htdocs/emandy/images/modperl.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
1
htdocs/emandy/index.html.html
Symbolic link
1
htdocs/emandy/index.html.html
Symbolic link
@@ -0,0 +1 @@
|
|||||||
|
index.html.xhtml
|
||||||
90
htdocs/emandy/index.html.xhtml
Normal file
90
htdocs/emandy/index.html.xhtml
Normal file
@@ -0,0 +1,90 @@
|
|||||||
|
<?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="text/html; 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:mandy@mail.emandy.idv.tw" />
|
||||||
|
<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="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>小招的網站</h1>
|
||||||
|
|
||||||
|
<p>網站架設中，敬請期待。妳可以先前往下列網站參觀：</p>
|
||||||
|
|
||||||
|
<ul>
|
||||||
|
<li><a href="http://www.wov.idv.tw/">《女聲》電子報</a></li>
|
||||||
|
<li><a href="http://htc.emandy.idv.tw/">歷史：理論與文化</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>
|
||||||
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>
|
||||||
10
htdocs/emandy/robots.txt
Normal file
10
htdocs/emandy/robots.txt
Normal file
@@ -0,0 +1,10 @@
|
|||||||
|
User-agent: *
|
||||||
|
Crawl-delay: 1
|
||||||
|
Disallow: /magicat/
|
||||||
|
Disallow: /legend/
|
||||||
|
|
||||||
|
User-agent: chklinks
|
||||||
|
Disallow:
|
||||||
|
|
||||||
|
User-agent: HTTrack
|
||||||
|
Disallow: /
|
||||||
152
htdocs/emandy/scripts/accounting.js
Normal file
152
htdocs/emandy/scripts/accounting.js
Normal file
@@ -0,0 +1,152 @@
|
|||||||
|
/* Mandy Wu's Website
|
||||||
|
* accounting.js: The accounting-related JavaScript subroutines.
|
||||||
|
*/
|
||||||
|
|
||||||
|
/* Copyright (c) 2007-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: 2007-09-26
|
||||||
|
*/
|
||||||
|
|
||||||
|
// setAutoSummary: Automatically supply a summary
|
||||||
|
function setAutoSummary(subj) {
|
||||||
|
var i, j, sum, dateText, today, subjText, subjCode, thisMonth;
|
||||||
|
// Get the name prefix of this selection
|
||||||
|
i = subj.name.indexOf("subj");
|
||||||
|
// Obtain the summary column
|
||||||
|
sum = subj.form[subj.name.substr(0, i) + "summary"];
|
||||||
|
// Get today's date
|
||||||
|
today = new Date;
|
||||||
|
dateText = trim(subj.form.date.value);
|
||||||
|
if (!isDate(dateText))
|
||||||
|
return;
|
||||||
|
today.setFullYear(dateText.substr(0, 4));
|
||||||
|
today.setMonth(dateText.substr(5, 2) - 1);
|
||||||
|
today.setDate(dateText.substr(8, 2));
|
||||||
|
thisMonth = today.getMonth() + 1;
|
||||||
|
// Obtain the selected subject
|
||||||
|
// The value of the selection is S/N but not subject code,
|
||||||
|
// so we have to obtain the subject code from the option text
|
||||||
|
subjText = subj.options[subj.selectedIndex].text;
|
||||||
|
subjCode = parseInt(subjText.substr(0, subjText.indexOf(" ")));
|
||||||
|
switch (subjCode) {
|
||||||
|
// 62561 和信 0927-02-1680
|
||||||
|
case 62561:
|
||||||
|
sum.value = "和信" + ((thisMonth + 10) % 12 + 1) + "月";
|
||||||
|
break;
|
||||||
|
// 21412 應付帳款—玉山信用卡
|
||||||
|
case 21412:
|
||||||
|
// Only fill in the debit side, as our repay
|
||||||
|
if (sum.name.substr(0, 4) == "debt") {
|
||||||
|
// 25 or later - assume to be of this month
|
||||||
|
if (today.getDate() >= 25) {
|
||||||
|
sum.value = "玉山信用卡" + thisMonth + "月";
|
||||||
|
// Before 25 - assume to be of previous month
|
||||||
|
} else {
|
||||||
|
sum.value = "玉山信用卡" + ((thisMonth + 10) % 12 + 1) + "月";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
// 21413 應付帳款—台新信用卡
|
||||||
|
case 21413:
|
||||||
|
// Only fill in the debitowing side, as our repay
|
||||||
|
if (sum.name.substr(0, 4) == "debt") {
|
||||||
|
// 25 or later - assume to be of this month
|
||||||
|
if (today.getDate() >= 25) {
|
||||||
|
sum.value = "台新信用卡" + thisMonth + "月";
|
||||||
|
// Before 25 - assume to be of previous month
|
||||||
|
} else {
|
||||||
|
sum.value = "台新信用卡" + ((thisMonth + 10) % 12 + 1) + "月";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
// acctRepQueryDisableNoUseRanges: Disable range parameters that are not in use
|
||||||
|
function acctRepQueryDisableNoUseRanges() {
|
||||||
|
var i, form, curValue;
|
||||||
|
// Obtain our form
|
||||||
|
form = document.forms["acctrepquery"];
|
||||||
|
if (form == undefined)
|
||||||
|
return;
|
||||||
|
// Find the current selection
|
||||||
|
for (i = 0; i < form.r.length; i++) {
|
||||||
|
if (form["r"][i].checked) {
|
||||||
|
curValue = form["r"][i].value;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
// Disable or enable the month selection
|
||||||
|
if (curValue == "m")
|
||||||
|
form["m"].disabled = false;
|
||||||
|
else
|
||||||
|
form["m"].disabled = true;
|
||||||
|
// Disable or enable the year selection
|
||||||
|
if (curValue == "y")
|
||||||
|
form["y"].disabled = false;
|
||||||
|
else
|
||||||
|
form["y"].disabled = true;
|
||||||
|
// Disable or enable the start and end date
|
||||||
|
if (curValue == "s") {
|
||||||
|
form["f"].disabled = false;
|
||||||
|
form["t"].disabled = false;
|
||||||
|
} else {
|
||||||
|
form["f"].disabled = true;
|
||||||
|
form["t"].disabled = true;
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
// calcTotal: Calculating the total
|
||||||
|
function calcTotal(amount) {
|
||||||
|
var i, j, side, sum, a, pos, isNumber;
|
||||||
|
a = "NT$ 3,433.00";
|
||||||
|
side = amount.name.substr(0, 4);
|
||||||
|
for ( i = 0, sum = 0;
|
||||||
|
amount.form[side + i + "amount"] != undefined;
|
||||||
|
i++) {
|
||||||
|
a = amount.form[side + i + "amount"];
|
||||||
|
// Trim the text
|
||||||
|
a.value = trim(a.value);
|
||||||
|
// Remove the dollar sign
|
||||||
|
if (a.value.substr(0, 3) == "NT$")
|
||||||
|
a.value = a.value.substr(3);
|
||||||
|
// Trim the text again, for possible spaces after the dollar sign
|
||||||
|
a.value = trim(a.value);
|
||||||
|
// Remove the decimal point
|
||||||
|
if (a.value.substr(a.value.length - 3) == ".00")
|
||||||
|
a.value = a.value.substr(0, a.value.length - 3);
|
||||||
|
// Remove the thousand seperators
|
||||||
|
while ((pos = a.value.indexOf(",")) != -1) {
|
||||||
|
a.value = a.value.substr(0, pos) + a.value.substr(pos + 1);
|
||||||
|
}
|
||||||
|
// Check if it is a number
|
||||||
|
for (j = 0, isNumber = true; j < a.value.length; j++) {
|
||||||
|
if (a.value.charCodeAt(j) < 48 || a.value.charCodeAt(j) > 57) {
|
||||||
|
isNumber = false;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
// Add the amount
|
||||||
|
if (isNumber)
|
||||||
|
sum = sum + a.value * 1;
|
||||||
|
}
|
||||||
|
a = amount.form[side + "total"];
|
||||||
|
if (a != undefined)
|
||||||
|
a.value = sum;
|
||||||
|
}
|
||||||
139
htdocs/emandy/scripts/common.js
Normal file
139
htdocs/emandy/scripts/common.js
Normal file
@@ -0,0 +1,139 @@
|
|||||||
|
/* Mandy Wu's Website
|
||||||
|
* common.js: The common JavaScript subroutines.
|
||||||
|
*/
|
||||||
|
|
||||||
|
/* Copyright (c) 2007-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: 2007-09-27
|
||||||
|
*/
|
||||||
|
|
||||||
|
// _: Gettext
|
||||||
|
function _(msg) {
|
||||||
|
var i;
|
||||||
|
for (i = 0; i < lc_messages.length; i++) {
|
||||||
|
if (lc_messages[i][0] == msg) {
|
||||||
|
return lc_messages[i][1];
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return msg;
|
||||||
|
}
|
||||||
|
// The messages
|
||||||
|
lc_messages = [];
|
||||||
|
|
||||||
|
// isEmail: Check if an email address is legal
|
||||||
|
function isEmail(a) {
|
||||||
|
var i, c, re;
|
||||||
|
if (typeof(RegExp) == "undefined") return true;
|
||||||
|
re = new RegExp("^[\\w\\-]+(\\.[\\w\\-]+)*\\@([\\w\\-]+\\.)+[\\w\\-]+$");
|
||||||
|
if (typeof(a) != "string") return false;
|
||||||
|
a = a.toLowerCase();
|
||||||
|
if (re.exec(a) == null) return false;
|
||||||
|
return true;
|
||||||
|
}
|
||||||
|
|
||||||
|
// isDate: Check if a date is legal
|
||||||
|
function isDate(dateText) {
|
||||||
|
var i, year, month, day, maxDay;
|
||||||
|
if (dateText.length != 10) {
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
// Check each character
|
||||||
|
for (i = 0; i < dateText.length; i++) {
|
||||||
|
// The dash sign
|
||||||
|
if (i == 4 || i == 7) {
|
||||||
|
if (dateText.charAt(i) != "-")
|
||||||
|
return false;
|
||||||
|
// The digits
|
||||||
|
} else {
|
||||||
|
if (dateText.charCodeAt(i) < 48 || dateText.charCodeAt(i) > 57)
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
// Check if the date is valid
|
||||||
|
year = dateText.substr(0, 4) * 1;
|
||||||
|
month = dateText.substr(5, 2) * 1;
|
||||||
|
day = dateText.substr(8, 2) * 1;
|
||||||
|
// A reasonable month
|
||||||
|
if (month < 1 || month > 12)
|
||||||
|
return false;
|
||||||
|
// Find the maximum day in this month
|
||||||
|
switch (month) {
|
||||||
|
case 1:
|
||||||
|
case 3:
|
||||||
|
case 5:
|
||||||
|
case 7:
|
||||||
|
case 8:
|
||||||
|
case 10:
|
||||||
|
case 12:
|
||||||
|
maxDay = 31;
|
||||||
|
break;
|
||||||
|
case 4:
|
||||||
|
case 6:
|
||||||
|
case 9:
|
||||||
|
case 11:
|
||||||
|
maxDay = 30;
|
||||||
|
break;
|
||||||
|
case 2:
|
||||||
|
maxDay = 28;
|
||||||
|
if (year % 4 == 0)
|
||||||
|
maxDay = 29;
|
||||||
|
if (year % 100 == 0)
|
||||||
|
maxDay = 28;
|
||||||
|
if (year % 400 == 0)
|
||||||
|
maxDay = 29;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
// A reasonable day
|
||||||
|
if (day < 1 || day > maxDay)
|
||||||
|
return false;
|
||||||
|
return true;
|
||||||
|
}
|
||||||
|
|
||||||
|
// trim: Trim the leading and tailing spaces
|
||||||
|
function trim(a) {
|
||||||
|
var pos, start, len, spaces;
|
||||||
|
start = 0;
|
||||||
|
len = a.length;
|
||||||
|
spaces = " \t\f\n\r";
|
||||||
|
for (start = 0; start < a.length && spaces.indexOf(a.charAt(start)) >= 0; start++, len--);
|
||||||
|
for (pos = a.length - 1; pos >= 0 && spaces.indexOf(a.charAt(pos)) >= 0; pos--, len--);
|
||||||
|
return a.substr(start, len);
|
||||||
|
}
|
||||||
|
function trimText(a) {
|
||||||
|
var pos, start, len, spaces, newlines;
|
||||||
|
start = 0;
|
||||||
|
len = a.length;
|
||||||
|
spaces = " \t\f\n\r";
|
||||||
|
newlines = "\n\r";
|
||||||
|
for (start = 0; start < a.length && spaces.indexOf(a.charAt(start)) >= 0; start++, len--);
|
||||||
|
for ( ; start-1 >= 0 && newlines.indexOf(a.charAt(start-1)) < 0; start--, len++);
|
||||||
|
for (pos = a.length - 1; pos >= 0 && spaces.indexOf(a.charAt(pos)) >= 0; pos--, len--);
|
||||||
|
return a.substr(start, len);
|
||||||
|
}
|
||||||
|
|
||||||
|
// Replace one phace with another in a string
|
||||||
|
function replace(source, oldStr, newStr) {
|
||||||
|
var pos;
|
||||||
|
pos = 0;
|
||||||
|
while (true) {
|
||||||
|
pos = source.indexOf(oldStr, pos);
|
||||||
|
if (pos == -1) break;
|
||||||
|
source = source.substr(0, pos) + newStr + source.substr(pos + oldStr.length)
|
||||||
|
pos += newStr.length;
|
||||||
|
}
|
||||||
|
return source;
|
||||||
|
}
|
||||||
26
htdocs/emandy/scripts/lang.zh-tw.js
Normal file
26
htdocs/emandy/scripts/lang.zh-tw.js
Normal file
@@ -0,0 +1,26 @@
|
|||||||
|
/* Mandy Wu's Website
|
||||||
|
* lang.zh-tw.js: The Chinese (Taiwan) localized messages.
|
||||||
|
*/
|
||||||
|
|
||||||
|
/* Copyright (c) 2007-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: 2007-09-27
|
||||||
|
*/
|
||||||
|
|
||||||
|
// The messages
|
||||||
|
lc_messages = [
|
||||||
|
];
|
||||||
29
htdocs/emandy/stylesheets/analog.css
Normal file
29
htdocs/emandy/stylesheets/analog.css
Normal file
@@ -0,0 +1,29 @@
|
|||||||
|
/* Mandy Wu's Website
|
||||||
|
* analog.css: The style sheet for Analog analysis reports.
|
||||||
|
*/
|
||||||
|
|
||||||
|
/* 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
|
||||||
|
*/
|
||||||
|
|
||||||
|
@import url("common.css");
|
||||||
|
|
||||||
|
p {
|
||||||
|
margin: 1em 0;
|
||||||
|
text-indent: 0;
|
||||||
|
}
|
||||||
353
htdocs/emandy/stylesheets/common.css
Normal file
353
htdocs/emandy/stylesheets/common.css
Normal file
@@ -0,0 +1,353 @@
|
|||||||
|
/* Mandy Wu's Website
|
||||||
|
* common.css: The common style sheet.
|
||||||
|
*/
|
||||||
|
|
||||||
|
/* 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
|
||||||
|
*/
|
||||||
|
|
||||||
|
/* General settings */
|
||||||
|
body {
|
||||||
|
/*background: white url("../images/backgrnd.gif") repeat-y scroll;*/
|
||||||
|
color: black;
|
||||||
|
margin: 0;
|
||||||
|
padding: 0.5em;
|
||||||
|
}
|
||||||
|
.body {
|
||||||
|
margin: 0;
|
||||||
|
padding: 1em 5em;
|
||||||
|
}
|
||||||
|
.body h1 {
|
||||||
|
margin-left: -1em;
|
||||||
|
}
|
||||||
|
a:link, a:visited, a:active {
|
||||||
|
background-color: transparent;
|
||||||
|
color: blue;
|
||||||
|
text-decoration: none;
|
||||||
|
}
|
||||||
|
a:hover {
|
||||||
|
background-color: yellow;
|
||||||
|
color: inherit;
|
||||||
|
text-decoration: underline;
|
||||||
|
}
|
||||||
|
p {
|
||||||
|
text-indent: 2em;
|
||||||
|
}
|
||||||
|
.en {
|
||||||
|
font-family: Arial, sans-serif;
|
||||||
|
}
|
||||||
|
p.en {
|
||||||
|
margin: 0 0 0.5em 0;
|
||||||
|
}
|
||||||
|
h1, h2, h3, h4, h5, h6 {
|
||||||
|
font-family: "標楷體", DFKai-SB, "DFKai SB", kai, serif;
|
||||||
|
font-weight: normal;
|
||||||
|
margin: 0 0 0.5em 0;
|
||||||
|
padding: 0;
|
||||||
|
}
|
||||||
|
address {
|
||||||
|
font-size: 0.833em;
|
||||||
|
display: block;
|
||||||
|
}
|
||||||
|
pre {
|
||||||
|
margin: 0;
|
||||||
|
}
|
||||||
|
dl dt {
|
||||||
|
margin: 0 0 0.5em 0;
|
||||||
|
font-family: "標楷體", DFKai-SB, "DFKai SB", kai, serif;
|
||||||
|
font-size: 1.44em;
|
||||||
|
}
|
||||||
|
dl dd {
|
||||||
|
margin: 0.5em 0 0.5em 3em;
|
||||||
|
}
|
||||||
|
caption {
|
||||||
|
font-family: "標楷體", DFKai-SB, "DFKai SB", kai, serif;
|
||||||
|
font-size: 1.44em;
|
||||||
|
}
|
||||||
|
form {
|
||||||
|
margin: 0;
|
||||||
|
}
|
||||||
|
#contents {
|
||||||
|
margin: 1em 15%;
|
||||||
|
}
|
||||||
|
.note {
|
||||||
|
font-size: 0.833em;
|
||||||
|
font-style: italic;
|
||||||
|
}
|
||||||
|
q {
|
||||||
|
quotes: "「" "」" "『" "』";
|
||||||
|
}
|
||||||
|
div.errmsg {
|
||||||
|
margin: 1em 0.5in;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* The navigation bar */
|
||||||
|
.navibar, .pagebar, .langs {
|
||||||
|
text-align: center;
|
||||||
|
font-size: 0.833em;
|
||||||
|
}
|
||||||
|
.navibar .text {
|
||||||
|
width: 4em;
|
||||||
|
}
|
||||||
|
.nav hr {
|
||||||
|
margin: 0.1em 0;
|
||||||
|
padding: 0;
|
||||||
|
height: 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* The title */
|
||||||
|
.title {
|
||||||
|
margin-left: 40px;
|
||||||
|
}
|
||||||
|
.intro {
|
||||||
|
margin: 1em 80px;
|
||||||
|
}
|
||||||
|
.toc {
|
||||||
|
margin: 1em 40px;
|
||||||
|
}
|
||||||
|
.toc li {
|
||||||
|
margin: 1em 40px;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* The footer */
|
||||||
|
.footer {
|
||||||
|
clear: both;
|
||||||
|
font-size: 0.833em;
|
||||||
|
text-align: center;
|
||||||
|
}
|
||||||
|
.footer p {
|
||||||
|
margin: 0;
|
||||||
|
text-indent: 0;
|
||||||
|
}
|
||||||
|
.footer img {
|
||||||
|
border-style: none;
|
||||||
|
}
|
||||||
|
.footer .modperl img {
|
||||||
|
height: 30px;
|
||||||
|
width: 110px;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* The default list */
|
||||||
|
.deflist {
|
||||||
|
margin: 1em 0;
|
||||||
|
}
|
||||||
|
.deflist th {
|
||||||
|
white-space: nowrap;
|
||||||
|
}
|
||||||
|
.deflist th, .deflist td {
|
||||||
|
padding: 0.2em 0.5em;
|
||||||
|
vertical-align: top;
|
||||||
|
}
|
||||||
|
.deflist thead {
|
||||||
|
background-color: silver;
|
||||||
|
color: black;
|
||||||
|
}
|
||||||
|
.deflist tbody th {
|
||||||
|
font-weight: normal;
|
||||||
|
}
|
||||||
|
.deflist .listno, .deflist .listdel {
|
||||||
|
text-align: center;
|
||||||
|
}
|
||||||
|
.deflist .oddrow {
|
||||||
|
background-color: #FFE0E0;
|
||||||
|
color: black;
|
||||||
|
}
|
||||||
|
.deflist .evenrow {
|
||||||
|
background-color: #E0E0FF;
|
||||||
|
color: black;
|
||||||
|
}
|
||||||
|
.deflist .amount {
|
||||||
|
text-align: right;
|
||||||
|
}
|
||||||
|
.deflist .amount .neg {
|
||||||
|
color: red;
|
||||||
|
background-color: transparent;
|
||||||
|
}
|
||||||
|
.deflist .crdtsubj {
|
||||||
|
text-indent: 2em;
|
||||||
|
}
|
||||||
|
.deflist .subjlv2 {
|
||||||
|
text-indent: 1em;
|
||||||
|
}
|
||||||
|
.deflist .subjlastlv {
|
||||||
|
text-indent: 2em;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* The default form */
|
||||||
|
.defform {
|
||||||
|
margin: 0;
|
||||||
|
width: 100%;
|
||||||
|
}
|
||||||
|
/* Refer to http://www.w3.org/Style/threepart-f.css */
|
||||||
|
/* The child selectors are a hack to hide these rules from WinIE6 */
|
||||||
|
body>form.defform {
|
||||||
|
width: auto;
|
||||||
|
}
|
||||||
|
.defform table {
|
||||||
|
margin: 0 auto;
|
||||||
|
width: 100%;
|
||||||
|
}
|
||||||
|
.defform th, .defform td {
|
||||||
|
text-align: left;
|
||||||
|
vertical-align: top;
|
||||||
|
}
|
||||||
|
.defform .thfile {
|
||||||
|
width: 9em;
|
||||||
|
}
|
||||||
|
.defform .th {
|
||||||
|
width: 8.5em;
|
||||||
|
}
|
||||||
|
.defform .oldnew {
|
||||||
|
width: 3.5em;
|
||||||
|
}
|
||||||
|
.defform td .text, .defform td textarea {
|
||||||
|
width: 100%;
|
||||||
|
}
|
||||||
|
.defform td .prompt {
|
||||||
|
font-style: italic;
|
||||||
|
margin: 0;
|
||||||
|
}
|
||||||
|
.defform td ol, .defform td li ul {
|
||||||
|
margin: 0 0 0 2em;
|
||||||
|
padding: 0;
|
||||||
|
}
|
||||||
|
.defform td ul, .defform td li {
|
||||||
|
margin: 0;
|
||||||
|
padding: 0;
|
||||||
|
}
|
||||||
|
.defform td ul li {
|
||||||
|
list-style: none;
|
||||||
|
}
|
||||||
|
.defform td .oneline li {
|
||||||
|
display: block;
|
||||||
|
float: left;
|
||||||
|
margin-right: 0.5em;
|
||||||
|
}
|
||||||
|
.defform td h4, .defform td .picinfo, .defform td .piccap {
|
||||||
|
margin: 0;
|
||||||
|
padding: 0;
|
||||||
|
}
|
||||||
|
.defform .amount {
|
||||||
|
text-align: right;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* The home page */
|
||||||
|
.covertoc h1, .covertoc h3 {
|
||||||
|
font-weight: bolder;
|
||||||
|
}
|
||||||
|
.covertoc ul li h2 {
|
||||||
|
font-size: 1.2em;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* The related links */
|
||||||
|
.links .linkslist {
|
||||||
|
margin: 1em 80px;
|
||||||
|
}
|
||||||
|
.links .linkslist li {
|
||||||
|
margin: 1em 0;
|
||||||
|
}
|
||||||
|
.links .linkslist li img {
|
||||||
|
vertical-align: top;
|
||||||
|
}
|
||||||
|
.links .linkslist li cite {
|
||||||
|
font-family: "標楷體", DFKai-SB, cursive, serif;
|
||||||
|
font-size: 1.2em;
|
||||||
|
font-style: normal;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* The blog */
|
||||||
|
.legend .entry {
|
||||||
|
padding: 1em;
|
||||||
|
margin: 1em 0;
|
||||||
|
border-width: thin thick thick thin;
|
||||||
|
border-style: solid;
|
||||||
|
border-color: #400020;
|
||||||
|
background-color: white;
|
||||||
|
color: inherit;
|
||||||
|
}
|
||||||
|
.legend .entry .freetext {
|
||||||
|
margin: 1em 0 0 0;
|
||||||
|
}
|
||||||
|
.legend .entry blockquote {
|
||||||
|
border-width: thin thick thick thin;
|
||||||
|
border-style: solid;
|
||||||
|
border-color: #400020;
|
||||||
|
margin: 1em;
|
||||||
|
padding: 1em;
|
||||||
|
}
|
||||||
|
@media screen, print {
|
||||||
|
.legend .entries hr {
|
||||||
|
display: none;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* The full text search */
|
||||||
|
.searchresult em {
|
||||||
|
background-color: yellow;
|
||||||
|
color: red;
|
||||||
|
}
|
||||||
|
.searchresult h3 {
|
||||||
|
margin: 0;
|
||||||
|
}
|
||||||
|
.searchresult li {
|
||||||
|
margin-bottom: 1em;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* The accessibility guides */
|
||||||
|
.skiptobody {
|
||||||
|
position: absolute;
|
||||||
|
line-height: 0;
|
||||||
|
left: 0;
|
||||||
|
top: 0;
|
||||||
|
z-index: -9;
|
||||||
|
}
|
||||||
|
.accessguide {
|
||||||
|
float: left;
|
||||||
|
font-size: 0.5em;
|
||||||
|
color: #FFFFFF;
|
||||||
|
}
|
||||||
|
.body .accessguide {
|
||||||
|
margin: 0 0 0 -10em;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* The preview mark */
|
||||||
|
.previewmark {
|
||||||
|
position: fixed;
|
||||||
|
top: 1em;
|
||||||
|
left: 1em;
|
||||||
|
border: thick solid red;
|
||||||
|
color: red;
|
||||||
|
background-color: transparent;
|
||||||
|
margin: 0;
|
||||||
|
padding: 0.5em;
|
||||||
|
}
|
||||||
|
.previewmark h2 {
|
||||||
|
text-transform: uppercase;
|
||||||
|
text-align: center;
|
||||||
|
margin: 0;
|
||||||
|
padding: 0;
|
||||||
|
}
|
||||||
|
.previewmark p {
|
||||||
|
margin: 0;
|
||||||
|
padding: 0;
|
||||||
|
text-indent: 0;
|
||||||
|
}
|
||||||
|
.previewmark a, .previewmark a:visited, .previewmark a:hover {
|
||||||
|
color: red;
|
||||||
|
background-color: transparent;
|
||||||
|
}
|
||||||
219
htdocs/emily/cgi-bin/counter.cgi
Executable file
219
htdocs/emily/cgi-bin/counter.cgi
Executable file
@@ -0,0 +1,219 @@
|
|||||||
|
#! /usr/bin/perl -w
|
||||||
|
# Emily Wu's Website
|
||||||
|
# counter.cgi: The visitor counter.
|
||||||
|
|
||||||
|
# Copyright (c) 2003-2021 imacat.
|
||||||
|
#
|
||||||
|
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||||
|
# you may not use this file except in compliance with the License.
|
||||||
|
# You may obtain a copy of the License at
|
||||||
|
#
|
||||||
|
# http://www.apache.org/licenses/LICENSE-2.0
|
||||||
|
#
|
||||||
|
# Unless required by applicable law or agreed to in writing, software
|
||||||
|
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||||
|
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||||
|
# See the License for the specific language governing permissions and
|
||||||
|
# limitations under the License.
|
||||||
|
|
||||||
|
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||||
|
# First written: 2003-04-07
|
||||||
|
|
||||||
|
use 5.008;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||||
|
use Selima::emily;
|
||||||
|
local $SIG{"__DIE__"} = \&http_500;
|
||||||
|
my $d = new Selima::Destroy;
|
||||||
|
# Prototype declaration
|
||||||
|
sub main();
|
||||||
|
sub dont_update();
|
||||||
|
sub read_counter();
|
||||||
|
sub update_counter();
|
||||||
|
sub log_visitor($);
|
||||||
|
sub counter_cookie();
|
||||||
|
sub html_image($);
|
||||||
|
|
||||||
|
use Fcntl qw(:seek);
|
||||||
|
use Date::Format qw(time2str);
|
||||||
|
use GD;
|
||||||
|
use IO::NestedCapture qw(CAPTURE_STDOUT);
|
||||||
|
use Net::CIDR::Lite qw();
|
||||||
|
|
||||||
|
use constant DATA_FILE => $ENV{"DOCUMENT_ROOT"} . "/magicat/data/counter.dat";
|
||||||
|
use constant LOG_FILE => "/var/log/apache2/emily/counter.log";
|
||||||
|
use vars qw($OUR_NETWORKS @FGCOLOR @BGCOLOR $FONT);
|
||||||
|
# People in our networks will not be counted
|
||||||
|
$OUR_NETWORKS = Net::CIDR::Lite->new(
|
||||||
|
qw(127.0.0.1/8 10.0.0.0/8 211.20.30.96/29));
|
||||||
|
@FGCOLOR = (0, 0, 0); # #000000 Black
|
||||||
|
@BGCOLOR = (255, 255, 255); # #FFFFFF White
|
||||||
|
$FONT = gdLargeFont;
|
||||||
|
use constant TRANSPARENT => 1;
|
||||||
|
use constant COOKIE_NAME => "counter";
|
||||||
|
use constant COUNT_ARG => "countme";
|
||||||
|
use constant IGNORE_ARG => "ignoreme";
|
||||||
|
initenv( -allowed => [qw(GET HEAD)],
|
||||||
|
-session => 0,
|
||||||
|
-dbi => DBI_NONE,
|
||||||
|
-lastmod => 0,
|
||||||
|
-multilang => 0);
|
||||||
|
|
||||||
|
main;
|
||||||
|
exit 0;
|
||||||
|
|
||||||
|
sub main() {
|
||||||
|
local ($_, %_);
|
||||||
|
|
||||||
|
# If we should not update the counter
|
||||||
|
if (dont_update) {
|
||||||
|
# Check last-modified here
|
||||||
|
my (@tables, @files);
|
||||||
|
@tables = qw();
|
||||||
|
@files = (DATA_FILE);
|
||||||
|
http_304 if not_modified @tables, @files;
|
||||||
|
html_image read_counter;
|
||||||
|
|
||||||
|
# Update the counter
|
||||||
|
} else {
|
||||||
|
$_ = html_image update_counter;
|
||||||
|
# Log the visitor
|
||||||
|
log_visitor $_;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Set the counter cookie
|
||||||
|
$NEWCOOKIES{COOKIE_NAME()} = $_ if defined ($_ = counter_cookie);
|
||||||
|
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
# dont_update: If we should not update the counter
|
||||||
|
sub dont_update() {
|
||||||
|
local ($_, %_);
|
||||||
|
# Find any reason that we should not update the counter
|
||||||
|
# If this visitor came from our own network
|
||||||
|
return 1 if $OUR_NETWORKS->find($ENV{"REMOTE_ADDR"});
|
||||||
|
# If this visitor had been counted
|
||||||
|
return 1 if exists $COOKIES{COOKIE_NAME()};
|
||||||
|
# If we are not told to count this visitor
|
||||||
|
return 1 if !defined $GET->param(COUNT_ARG);
|
||||||
|
# Well, update it
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
# read_counter: Read the counter
|
||||||
|
sub read_counter() {
|
||||||
|
return -s DATA_FILE? xfread DATA_FILE: 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
# update_counter: Update the counter
|
||||||
|
sub update_counter() {
|
||||||
|
local ($_, %_);
|
||||||
|
# File exists
|
||||||
|
if (-s DATA_FILE) {
|
||||||
|
my $FH;
|
||||||
|
open $FH, "+<", DATA_FILE or http_500 DATA_FILE . ": $!";
|
||||||
|
flock $FH, LOCK_EX or http_500 DATA_FILE . ": $!";
|
||||||
|
$_ = <$FH>;
|
||||||
|
$_++;
|
||||||
|
seek $FH, 0, SEEK_SET or http_500 DATA_FILE . ": $!";
|
||||||
|
truncate $FH, 0 or http_500 DATA_FILE . ": $!";
|
||||||
|
print $FH $_ or http_500 DATA_FILE . ": $!";
|
||||||
|
flock $FH, LOCK_UN or http_500 DATA_FILE . ": $!";
|
||||||
|
close $FH or http_500 DATA_FILE . ": $!";
|
||||||
|
|
||||||
|
# Not exists or zero sized -- create a new one
|
||||||
|
} else {
|
||||||
|
xfwrite DATA_FILE, ($_ = 1);
|
||||||
|
}
|
||||||
|
return $_;
|
||||||
|
}
|
||||||
|
|
||||||
|
# log_visitor: Log the visitor
|
||||||
|
sub log_visitor($) {
|
||||||
|
local ($_, %_);
|
||||||
|
my ($host, $user, $date, $uri, $size, $referer, $ua, $langs, $FD);
|
||||||
|
$size = $_[0];
|
||||||
|
|
||||||
|
# Gather the infomation to log
|
||||||
|
$host = (defined remote_host)? remote_host: $ENV{"REMOTE_ADDR"};
|
||||||
|
$user = (exists $ENV{"REMOTE_USER"} && $ENV{"REMOTE_USER"} ne "")?
|
||||||
|
$ENV{"REMOTE_USER"}: "-";
|
||||||
|
$date = time2str("%d/%b/%Y:%T %z", time);
|
||||||
|
$uri = $REQUEST_URI;
|
||||||
|
$referer = (exists $ENV{"HTTP_REFERER"} && $ENV{"HTTP_REFERER"} ne "")?
|
||||||
|
$ENV{"HTTP_REFERER"}: "-";
|
||||||
|
$ua = (exists $ENV{"HTTP_USER_AGENT"} && $ENV{"HTTP_USER_AGENT"} ne "")?
|
||||||
|
$ENV{"HTTP_USER_AGENT"}: "=";
|
||||||
|
$langs = (exists $ENV{"HTTP_ACCEPT_LANGUAGE"} && $ENV{"HTTP_ACCEPT_LANGUAGE"} ne "")?
|
||||||
|
$ENV{"HTTP_ACCEPT_LANGUAGE"}: "-";
|
||||||
|
|
||||||
|
# Compose the log record 組合紀錄行
|
||||||
|
$_ = sprintf "%s - %s [%s] \"%s %s %s\" 200 %s \"%s\" \"%s\" \"%s\" %s %s\n",
|
||||||
|
$host, $user, $date, $ENV{"REQUEST_METHOD"}, $uri,
|
||||||
|
$ENV{"SERVER_PROTOCOL"}, $size, $referer, $ua, $langs,
|
||||||
|
$ENV{"REMOTE_ADDR"}, country_lookup($ENV{"REMOTE_ADDR"});
|
||||||
|
|
||||||
|
# Save the log record 儲存記錄
|
||||||
|
xfappend LOG_FILE, $_;
|
||||||
|
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
# counter_cookie: Set the counter cookie
|
||||||
|
sub counter_cookie() {
|
||||||
|
local ($_, %_);
|
||||||
|
# Leave our network alone
|
||||||
|
return if $OUR_NETWORKS->find($ENV{"REMOTE_ADDR"});
|
||||||
|
# Already set
|
||||||
|
return if exists $COOKIES{COOKIE_NAME()};
|
||||||
|
# Count me
|
||||||
|
return new CGI::Cookie( -name=>COOKIE_NAME,
|
||||||
|
-value=>"counted",
|
||||||
|
-path=>$REQUEST_PATH)
|
||||||
|
if defined $GET->param(COUNT_ARG);
|
||||||
|
# Ignore me
|
||||||
|
return new CGI::Cookie( -name=>COOKIE_NAME,
|
||||||
|
-value=>"ignored",
|
||||||
|
-path=>$REQUEST_PATH)
|
||||||
|
if defined $GET->param(IGNORE_ARG);
|
||||||
|
# Leave it alone
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
# html_image: Make the image from the counter value
|
||||||
|
sub html_image($) {
|
||||||
|
local $_;
|
||||||
|
my ($counter, $image, $width, $height, $fgcolor, $bgcolor);
|
||||||
|
$counter = $_[0];
|
||||||
|
|
||||||
|
# Group the counter with commas at thousand digits.
|
||||||
|
$counter = fmtno($counter);
|
||||||
|
|
||||||
|
# Initialize the image object
|
||||||
|
# Get the width and height
|
||||||
|
$width = $FONT->width * (length $counter);
|
||||||
|
$height = $FONT->height;
|
||||||
|
# Create an image object
|
||||||
|
$image = GD::Image->new($width, $height);
|
||||||
|
# Create the forground/background color objects
|
||||||
|
$fgcolor = $image->colorAllocate(@FGCOLOR);
|
||||||
|
$bgcolor = $image->colorAllocate(@BGCOLOR);
|
||||||
|
|
||||||
|
# Draw the image
|
||||||
|
# Set the transparent background
|
||||||
|
$image->transparent($bgcolor) if TRANSPARENT;
|
||||||
|
# Paint the background
|
||||||
|
$image->filledRectangle(0, 0, $width, $height, $bgcolor);
|
||||||
|
# Write the text
|
||||||
|
$image->string($FONT, 0, 0, $counter, $fgcolor);
|
||||||
|
|
||||||
|
# Output
|
||||||
|
$CONTENT_TYPE = "image/png";
|
||||||
|
binmode IO::NestedCapture->instance->{"STDOUT_current"}[-1];
|
||||||
|
$_ = $image->png;
|
||||||
|
print $_;
|
||||||
|
|
||||||
|
return length $_;
|
||||||
|
}
|
||||||
142
htdocs/emily/cgi-bin/last_update.cgi
Executable file
142
htdocs/emily/cgi-bin/last_update.cgi
Executable file
@@ -0,0 +1,142 @@
|
|||||||
|
#! /usr/bin/perl -w
|
||||||
|
# Emily Wu's Website
|
||||||
|
# last_update.cgi: The last-update date of the whole web site.
|
||||||
|
|
||||||
|
# Copyright (c) 2003-2021 imacat.
|
||||||
|
#
|
||||||
|
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||||
|
# you may not use this file except in compliance with the License.
|
||||||
|
# You may obtain a copy of the License at
|
||||||
|
#
|
||||||
|
# http://www.apache.org/licenses/LICENSE-2.0
|
||||||
|
#
|
||||||
|
# Unless required by applicable law or agreed to in writing, software
|
||||||
|
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||||
|
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||||
|
# See the License for the specific language governing permissions and
|
||||||
|
# limitations under the License.
|
||||||
|
|
||||||
|
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||||
|
# First written: 2003-04-09
|
||||||
|
|
||||||
|
use 5.008;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||||
|
use Selima::emily;
|
||||||
|
local $SIG{"__DIE__"} = \&http_500;
|
||||||
|
my $d = new Selima::Destroy;
|
||||||
|
# Prototype declaration
|
||||||
|
sub main();
|
||||||
|
sub find_files_in(\@\@);
|
||||||
|
sub fmttime_local($);
|
||||||
|
sub html_image($);
|
||||||
|
|
||||||
|
use File::Spec;
|
||||||
|
use GD;
|
||||||
|
use IO::NestedCapture qw(CAPTURE_STDOUT);
|
||||||
|
|
||||||
|
use vars qw(@DIREXCS %RDIREXCS @FGCOLOR @BGCOLOR $FONT);
|
||||||
|
# Directories to be excluded (no leading and trailing slashes)
|
||||||
|
@DIREXCS = qw(magicat);
|
||||||
|
@FGCOLOR = (0, 0, 0); # #000000 Black
|
||||||
|
@BGCOLOR = (255, 255, 255); # #FFFFFF White
|
||||||
|
$FONT = gdLargeFont;
|
||||||
|
use constant TRANSPARENT => 1;
|
||||||
|
initenv( -allowed => [qw(GET HEAD)],
|
||||||
|
-session => 0,
|
||||||
|
-dbi => DBI_NONE,
|
||||||
|
-lastmod => 0,
|
||||||
|
-multilang => 0);
|
||||||
|
%RDIREXCS = map { File::Spec->catfile($DOC_ROOT, $_) => 1 } @DIREXCS;
|
||||||
|
|
||||||
|
main;
|
||||||
|
exit 0;
|
||||||
|
|
||||||
|
sub main() {
|
||||||
|
local ($_, %_);
|
||||||
|
my (@tables, @files);
|
||||||
|
|
||||||
|
@tables = qw();
|
||||||
|
@files = qw();
|
||||||
|
@_ = ($DOC_ROOT);
|
||||||
|
find_files_in(@files, @_);
|
||||||
|
http_304 if not_modified @tables, @files;
|
||||||
|
|
||||||
|
html_image($LAST_MODIFIED);
|
||||||
|
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
# find_files_in: an easy file finder
|
||||||
|
sub find_files_in(\@\@) {
|
||||||
|
local ($_, %_);
|
||||||
|
my ($files, $dirs, @subdirs, $DH, $ent);
|
||||||
|
($files, $dirs) = @_;
|
||||||
|
|
||||||
|
# Bounce for nothing
|
||||||
|
return if scalar(@$dirs) == 0;
|
||||||
|
# Look in these directories
|
||||||
|
@subdirs = qw();
|
||||||
|
foreach my $dir (@$dirs) {
|
||||||
|
$dir =~ s/\/$//;
|
||||||
|
opendir $DH, $dir or die "$dir: $!";
|
||||||
|
while (defined($_ = readdir $DH)) {
|
||||||
|
next if /^\./;
|
||||||
|
# Using catfile() is better, but a lot slower
|
||||||
|
$ent = File::Spec->catfile($dir, $_);
|
||||||
|
#$ent = "$dir/$_";
|
||||||
|
if (-f $ent) {
|
||||||
|
push @$files, $ent;
|
||||||
|
} elsif (-d $ent) {
|
||||||
|
push @subdirs, $ent
|
||||||
|
if !exists $RDIREXCS{$ent};
|
||||||
|
}
|
||||||
|
}
|
||||||
|
closedir $DH or die "$dir: $!";
|
||||||
|
}
|
||||||
|
# Look in the subdirectories
|
||||||
|
find_files_in @$files, @subdirs;
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
# fmttime_local: Format the time using my own format
|
||||||
|
sub fmttime_local($) {
|
||||||
|
@_ = localtime $_[0];
|
||||||
|
return sprintf "%d.%d.'%02d", $_[4]+1, $_[3], ($_[5]+1900) % 100;
|
||||||
|
}
|
||||||
|
|
||||||
|
# html_image: Make the image from the last-update value
|
||||||
|
sub html_image($) {
|
||||||
|
local $_;
|
||||||
|
my ($last_update, $image, $width, $height, $fgcolor, $bgcolor);
|
||||||
|
$last_update = $_[0];
|
||||||
|
|
||||||
|
# Format the date to my preferred format
|
||||||
|
$last_update = fmttime_local($last_update);
|
||||||
|
|
||||||
|
# Initialize the image object
|
||||||
|
# Get the width and height
|
||||||
|
$width = $FONT->width * (length $last_update);
|
||||||
|
$height = $FONT->height;
|
||||||
|
# Create an image object
|
||||||
|
$image = GD::Image->new($width, $height);
|
||||||
|
# Create the forground/background color objects
|
||||||
|
$fgcolor = $image->colorAllocate(@FGCOLOR);
|
||||||
|
$bgcolor = $image->colorAllocate(@BGCOLOR);
|
||||||
|
|
||||||
|
# Draw the image
|
||||||
|
# Set the transparent background
|
||||||
|
$image->transparent($bgcolor) if TRANSPARENT;
|
||||||
|
# Paint the background
|
||||||
|
$image->filledRectangle(0, 0, $width, $height, $bgcolor);
|
||||||
|
# Write the text
|
||||||
|
$image->string($FONT, 0, 0, $last_update, $fgcolor);
|
||||||
|
|
||||||
|
# Output
|
||||||
|
$CONTENT_TYPE = "image/png";
|
||||||
|
binmode IO::NestedCapture->instance->{"STDOUT_current"}[-1], ":raw";
|
||||||
|
print $image->png;
|
||||||
|
|
||||||
|
return;
|
||||||
|
}
|
||||||
70
htdocs/emily/cgi-bin/mailto.cgi
Executable file
70
htdocs/emily/cgi-bin/mailto.cgi
Executable file
@@ -0,0 +1,70 @@
|
|||||||
|
#! /usr/bin/perl -w
|
||||||
|
# Emily Wu's Website
|
||||||
|
# mailto.cgi: The e-mail hyperlink redirector.
|
||||||
|
|
||||||
|
# Copyright (c) 2003-2021 imacat.
|
||||||
|
#
|
||||||
|
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||||
|
# you may not use this file except in compliance with the License.
|
||||||
|
# You may obtain a copy of the License at
|
||||||
|
#
|
||||||
|
# http://www.apache.org/licenses/LICENSE-2.0
|
||||||
|
#
|
||||||
|
# Unless required by applicable law or agreed to in writing, software
|
||||||
|
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||||
|
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||||
|
# See the License for the specific language governing permissions and
|
||||||
|
# limitations under the License.
|
||||||
|
|
||||||
|
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||||
|
# First written: 2003-05-13
|
||||||
|
|
||||||
|
use 5.008;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||||
|
use Selima::emily;
|
||||||
|
local $SIG{"__DIE__"} = \&http_500;
|
||||||
|
my $d = new Selima::Destroy;
|
||||||
|
# Prototype declaration
|
||||||
|
sub main();
|
||||||
|
sub check_post();
|
||||||
|
|
||||||
|
use Fcntl qw(:seek);
|
||||||
|
|
||||||
|
initenv(-allowed => [qw(POST)],
|
||||||
|
-session => 0,
|
||||||
|
-dbi => DBI_NONE,
|
||||||
|
-lastmod => 0);
|
||||||
|
|
||||||
|
main;
|
||||||
|
exit 0;
|
||||||
|
|
||||||
|
sub main() {
|
||||||
|
local ($_, %_);
|
||||||
|
my $error;
|
||||||
|
|
||||||
|
# Only POSTed forms are allowed
|
||||||
|
$error = check_post;
|
||||||
|
# If an error occurs
|
||||||
|
if (defined $error) {
|
||||||
|
http_400;
|
||||||
|
|
||||||
|
# Else, save the data
|
||||||
|
} else {
|
||||||
|
http_303 "mailto:" . $POST->param("email");
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
# check_post: Check the POSTed form
|
||||||
|
sub check_post() {
|
||||||
|
local ($_, %_);
|
||||||
|
my ($checker, $error);
|
||||||
|
# Run the checker
|
||||||
|
$checker = new Selima::Checker::MailTo(curform);
|
||||||
|
$error = $checker->check(qw(email));
|
||||||
|
return $error if defined $error;
|
||||||
|
# OK
|
||||||
|
return;
|
||||||
|
}
|
||||||
55
htdocs/emily/cgi-bin/search.cgi
Executable file
55
htdocs/emily/cgi-bin/search.cgi
Executable file
@@ -0,0 +1,55 @@
|
|||||||
|
#! /usr/bin/perl -w
|
||||||
|
# Emily Wu's Website
|
||||||
|
# search.cgi: The web site full-text search.
|
||||||
|
|
||||||
|
# Copyright (c) 2006-2021 imacat.
|
||||||
|
#
|
||||||
|
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||||
|
# you may not use this file except in compliance with the License.
|
||||||
|
# You may obtain a copy of the License at
|
||||||
|
#
|
||||||
|
# http://www.apache.org/licenses/LICENSE-2.0
|
||||||
|
#
|
||||||
|
# Unless required by applicable law or agreed to in writing, software
|
||||||
|
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||||
|
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||||
|
# See the License for the specific language governing permissions and
|
||||||
|
# limitations under the License.
|
||||||
|
|
||||||
|
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||||
|
# First written: 2006-04-11
|
||||||
|
|
||||||
|
use 5.008;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
|
||||||
|
use Selima::emily;
|
||||||
|
local $SIG{"__DIE__"} = \&http_500;
|
||||||
|
my $d = new Selima::Destroy;
|
||||||
|
# Prototype declaration
|
||||||
|
sub main();
|
||||||
|
|
||||||
|
use Fcntl qw(:seek);
|
||||||
|
|
||||||
|
initenv(-allowed => [qw(GET HEAD)],
|
||||||
|
-session => 0,
|
||||||
|
-dbi_lock => {"pages" => LOCK_SH,
|
||||||
|
"links" => LOCK_SH,
|
||||||
|
"guestbook" => LOCK_SH},
|
||||||
|
-lastmod => 1,
|
||||||
|
-page_param => {"keywords" => N_("search, query, full text search"),
|
||||||
|
"class" => "search"});
|
||||||
|
|
||||||
|
main;
|
||||||
|
exit 0;
|
||||||
|
|
||||||
|
sub main() {
|
||||||
|
local ($_, %_);
|
||||||
|
my $LIST;
|
||||||
|
# List handler handles its own error
|
||||||
|
$LIST = new Selima::emily::List::Search;
|
||||||
|
html_header $LIST->{"title"}, $LIST->page_param;
|
||||||
|
$LIST->html;
|
||||||
|
html_footer;
|
||||||
|
return;
|
||||||
|
}
|
||||||
1
htdocs/emily/copying.html.html
Symbolic link
1
htdocs/emily/copying.html.html
Symbolic link
@@ -0,0 +1 @@
|
|||||||
|
copying.html.xhtml
|
||||||
118
htdocs/emily/copying.html.xhtml
Normal file
118
htdocs/emily/copying.html.xhtml
Normal file
@@ -0,0 +1,118 @@
|
|||||||
|
<?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="© 2000-2018 依瑪貓。依瑪貓保有所有權利。" />
|
||||||
|
<meta name="keywords" content="著作權, 版權" />
|
||||||
|
<meta name="generator" content="Selima 3.10" />
|
||||||
|
<link rel="start" type="application/xhtml+xml" href="." />
|
||||||
|
<link rel="copyright" type="application/xhtml+xml" href="copying.html" />
|
||||||
|
<link rel="author" href="mailto:emily6wu@ms27.hinet.net" />
|
||||||
|
<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="." title="回到吳芳美網站的首頁">首頁</a></span> |
|
||||||
|
<span><a href="cgi-bin/guestbook.cgi" title="妳可以到這裏留言給吳芳美，我會儘快給妳回覆">留言板</a></span> |
|
||||||
|
<span><a href="links/" title="這裏搜集了很多和旅遊相關的網站">相關連結</a></span> |
|
||||||
|
<span><a href="mailto:emily6wu@ms27.hinet.net" title="不要忘記寫 E-mail 給我喔！ ^_^"><em><acronym title="electronic mail" xml:lang="en">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>吳芳美網站版權聲明</h1>
|
||||||
|
|
||||||
|
<h2>吳芳美網站版權聲明</h2>
|
||||||
|
|
||||||
|
<p>吳芳美網站除留言板外，所有圖、文版權屬依瑪貓所有，歡迎轉載、引用，唯請遵守以下事項：</p>
|
||||||
|
|
||||||
|
<ol>
|
||||||
|
<li><em>必須</em>以下列格式，註明原作者及出處網址：
|
||||||
|
<pre>作者：依瑪貓， http://emily.imacat.idv.tw/某某頁.html</pre>
|
||||||
|
</li>
|
||||||
|
<li>不得對內容作任何更動、添增、刪改。</li>
|
||||||
|
<li>吳芳美網站所有文字，除留言板外，歡迎非商業自由轉載、引用。欲作商業或學術文字轉載（含論文發表、媒體報導、書刊出版），<em>必須</em>事先取得依瑪貓同意。</li>
|
||||||
|
<li>吳芳美網站所有圖片，在事先知會依瑪貓之下，歡迎非商業自由轉載、引用。欲作商業或學術轉載（含論文發表、媒體報導、書刊出版），<em>必須</em>事先取得依瑪貓同意。</li>
|
||||||
|
<li>吳芳美網站留言板留言版權與吳芳美網站無關，另以<cite>留言板版權聲明</cite>為準。</li>
|
||||||
|
</ol>
|
||||||
|
|
||||||
|
|
||||||
|
<h2>吳芳美網站留言板版權聲明</h2>
|
||||||
|
|
||||||
|
<p>吳芳美網站所有留言板留言版權屬各留言人所有，<em>與吳芳美網站無關</em>。<cite>吳芳美網站版權聲明</cite>不適用於留言板留言。欲轉載、引用任何留言板留言，<em>必須</em>事先取得各該留言人之同意。若無法連絡該留言人，一律禁止轉載、引用。</p>
|
||||||
|
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<hr />
|
||||||
|
<div id="footer" class="footer" title="頁尾區">
|
||||||
|
<div>
|
||||||
|
<img class="pridetouricon" src="images/pridetour" alt="尊貴假期" />
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<div>
|
||||||
|
吳芳美 Emily Wu<br />
|
||||||
|
金興旅行社 業務經理<br />
|
||||||
|
電話: (07) 311-3916 / 手機: (0933) 38-6779 / 傳真: (07) 311-4028<br />
|
||||||
|
地址: 高雄市三民區博愛一路 28 號 13 樓<br />
|
||||||
|
<acronym title="electronic mail">E-mail</acronym>: <a href="mailto:emily6wu@ms27.hinet.net">emily6wu@ms27.hinet.net</a><br />
|
||||||
|
網址: <a href=".">http://emily.imacat.idv.tw/</a><br />
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<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>版權所有 © 2000-2018 依瑪貓，欲轉載引用請先閱讀<a href="copying.html">版權聲明</a>。</p>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
</div>
|
||||||
|
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
1
htdocs/emily/errors/301.html.html
Symbolic link
1
htdocs/emily/errors/301.html.html
Symbolic link
@@ -0,0 +1 @@
|
|||||||
|
301.html.xhtml
|
||||||
100
htdocs/emily/errors/301.html.xhtml
Normal file
100
htdocs/emily/errors/301.html.xhtml
Normal file
@@ -0,0 +1,100 @@
|
|||||||
|
<?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="© 2000-2018 依瑪貓。依瑪貓保有所有權利。" />
|
||||||
|
<meta name="keywords" content="網址已遷" />
|
||||||
|
<meta name="generator" content="Selima 3.10" />
|
||||||
|
<link rel="start" type="application/xhtml+xml" href="/" />
|
||||||
|
<link rel="copyright" type="application/xhtml+xml" href="/copying.html" />
|
||||||
|
<link rel="author" href="mailto:emily6wu@ms27.hinet.net" />
|
||||||
|
<link rel="stylesheet" type="text/css" href="/stylesheets/common.css" />
|
||||||
|
<link rel="shortcut icon" type="image/x-icon" href="/favicon.ico" />
|
||||||
|
<title>HTTP 301 網址已遷</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="/" title="回到吳芳美網站的首頁">首頁</a></span> |
|
||||||
|
<span><a href="/cgi-bin/guestbook.cgi" title="妳可以到這裏留言給吳芳美，我會儘快給妳回覆">留言板</a></span> |
|
||||||
|
<span><a href="/links/" title="這裏搜集了很多和旅遊相關的網站">相關連結</a></span> |
|
||||||
|
<span><a href="mailto:emily6wu@ms27.hinet.net" title="不要忘記寫 E-mail 給我喔！ ^_^"><em><acronym title="electronic mail" xml:lang="en">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><abbr title="HyperText Transfer Protocol">HTTP</abbr> 301 網址已遷</h1>
|
||||||
|
|
||||||
|
<p>本頁已遷址，日後請更新妳的書籤或妳的最愛，並改往<a href="$url">新址</a>。</p>
|
||||||
|
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<hr />
|
||||||
|
<div id="footer" class="footer" title="頁尾區">
|
||||||
|
<div>
|
||||||
|
<img class="pridetouricon" src="/images/pridetour" alt="尊貴假期" />
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<div>
|
||||||
|
吳芳美 Emily Wu<br />
|
||||||
|
金興旅行社 業務經理<br />
|
||||||
|
電話: (07) 311-3916 / 手機: (0933) 38-6779 / 傳真: (07) 311-4028<br />
|
||||||
|
地址: 高雄市三民區博愛一路 28 號 13 樓<br />
|
||||||
|
<acronym title="electronic mail">E-mail</acronym>: <a href="mailto:emily6wu@ms27.hinet.net">emily6wu@ms27.hinet.net</a><br />
|
||||||
|
網址: <a href="http://emily.imacat.idv.tw/">http://emily.imacat.idv.tw/</a><br />
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<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>版權所有 © 2000-2018 依瑪貓，欲轉載引用請先閱讀<a href="/copying.html">版權聲明</a>。</p>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
</div>
|
||||||
|
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
1
htdocs/emily/errors/303.html.html
Symbolic link
1
htdocs/emily/errors/303.html.html
Symbolic link
@@ -0,0 +1 @@
|
|||||||
|
303.html.xhtml
|
||||||
100
htdocs/emily/errors/303.html.xhtml
Normal file
100
htdocs/emily/errors/303.html.xhtml
Normal file
@@ -0,0 +1,100 @@
|
|||||||
|
<?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="© 2000-2018 依瑪貓。依瑪貓保有所有權利。" />
|
||||||
|
<meta name="keywords" content="續往下址" />
|
||||||
|
<meta name="generator" content="Selima 3.10" />
|
||||||
|
<link rel="start" type="application/xhtml+xml" href="/" />
|
||||||
|
<link rel="copyright" type="application/xhtml+xml" href="/copying.html" />
|
||||||
|
<link rel="author" href="mailto:emily6wu@ms27.hinet.net" />
|
||||||
|
<link rel="stylesheet" type="text/css" href="/stylesheets/common.css" />
|
||||||
|
<link rel="shortcut icon" type="image/x-icon" href="/favicon.ico" />
|
||||||
|
<title>HTTP 303 續往下址</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="/" title="回到吳芳美網站的首頁">首頁</a></span> |
|
||||||
|
<span><a href="/cgi-bin/guestbook.cgi" title="妳可以到這裏留言給吳芳美，我會儘快給妳回覆">留言板</a></span> |
|
||||||
|
<span><a href="/links/" title="這裏搜集了很多和旅遊相關的網站">相關連結</a></span> |
|
||||||
|
<span><a href="mailto:emily6wu@ms27.hinet.net" title="不要忘記寫 E-mail 給我喔！ ^_^"><em><acronym title="electronic mail" xml:lang="en">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><abbr title="HyperText Transfer Protocol">HTTP</abbr> 303 續往下址</h1>
|
||||||
|
|
||||||
|
<p>請續往<a href="$url">後續的網址</a>。</p>
|
||||||
|
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<hr />
|
||||||
|
<div id="footer" class="footer" title="頁尾區">
|
||||||
|
<div>
|
||||||
|
<img class="pridetouricon" src="/images/pridetour" alt="尊貴假期" />
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<div>
|
||||||
|
吳芳美 Emily Wu<br />
|
||||||
|
金興旅行社 業務經理<br />
|
||||||
|
電話: (07) 311-3916 / 手機: (0933) 38-6779 / 傳真: (07) 311-4028<br />
|
||||||
|
地址: 高雄市三民區博愛一路 28 號 13 樓<br />
|
||||||
|
<acronym title="electronic mail">E-mail</acronym>: <a href="mailto:emily6wu@ms27.hinet.net">emily6wu@ms27.hinet.net</a><br />
|
||||||
|
網址: <a href="http://emily.imacat.idv.tw/">http://emily.imacat.idv.tw/</a><br />
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<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>版權所有 © 2000-2018 依瑪貓，欲轉載引用請先閱讀<a href="/copying.html">版權聲明</a>。</p>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
</div>
|
||||||
|
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
1
htdocs/emily/errors/307.html.html
Symbolic link
1
htdocs/emily/errors/307.html.html
Symbolic link
@@ -0,0 +1 @@
|
|||||||
|
307.html.xhtml
|
||||||
100
htdocs/emily/errors/307.html.xhtml
Normal file
100
htdocs/emily/errors/307.html.xhtml
Normal file
@@ -0,0 +1,100 @@
|
|||||||
|
<?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="© 2000-2018 依瑪貓。依瑪貓保有所有權利。" />
|
||||||
|
<meta name="keywords" content="網址暫移" />
|
||||||
|
<meta name="generator" content="Selima 3.10" />
|
||||||
|
<link rel="start" type="application/xhtml+xml" href="/" />
|
||||||
|
<link rel="copyright" type="application/xhtml+xml" href="/copying.html" />
|
||||||
|
<link rel="author" href="mailto:emily6wu@ms27.hinet.net" />
|
||||||
|
<link rel="stylesheet" type="text/css" href="/stylesheets/common.css" />
|
||||||
|
<link rel="shortcut icon" type="image/x-icon" href="/favicon.ico" />
|
||||||
|
<title>HTTP 307 網址暫移</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="/" title="回到吳芳美網站的首頁">首頁</a></span> |
|
||||||
|
<span><a href="/cgi-bin/guestbook.cgi" title="妳可以到這裏留言給吳芳美，我會儘快給妳回覆">留言板</a></span> |
|
||||||
|
<span><a href="/links/" title="這裏搜集了很多和旅遊相關的網站">相關連結</a></span> |
|
||||||
|
<span><a href="mailto:emily6wu@ms27.hinet.net" title="不要忘記寫 E-mail 給我喔！ ^_^"><em><acronym title="electronic mail" xml:lang="en">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><abbr title="HyperText Transfer Protocol">HTTP</abbr> 307 網址暫移</h1>
|
||||||
|
|
||||||
|
<p>請參閱本頁<a href="$url">目前的網址</a>。</p>
|
||||||
|
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<hr />
|
||||||
|
<div id="footer" class="footer" title="頁尾區">
|
||||||
|
<div>
|
||||||
|
<img class="pridetouricon" src="/images/pridetour" alt="尊貴假期" />
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<div>
|
||||||
|
吳芳美 Emily Wu<br />
|
||||||
|
金興旅行社 業務經理<br />
|
||||||
|
電話: (07) 311-3916 / 手機: (0933) 38-6779 / 傳真: (07) 311-4028<br />
|
||||||
|
地址: 高雄市三民區博愛一路 28 號 13 樓<br />
|
||||||
|
<acronym title="electronic mail">E-mail</acronym>: <a href="mailto:emily6wu@ms27.hinet.net">emily6wu@ms27.hinet.net</a><br />
|
||||||
|
網址: <a href="http://emily.imacat.idv.tw/">http://emily.imacat.idv.tw/</a><br />
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<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>版權所有 © 2000-2018 依瑪貓，欲轉載引用請先閱讀<a href="/copying.html">版權聲明</a>。</p>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
</div>
|
||||||
|
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
1
htdocs/emily/errors/400.html.html
Symbolic link
1
htdocs/emily/errors/400.html.html
Symbolic link
@@ -0,0 +1 @@
|
|||||||
|
400.html.xhtml
|
||||||
104
htdocs/emily/errors/400.html.xhtml
Normal file
104
htdocs/emily/errors/400.html.xhtml
Normal file
@@ -0,0 +1,104 @@
|
|||||||
|
<?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="© 2000-2018 依瑪貓。依瑪貓保有所有權利。" />
|
||||||
|
<meta name="keywords" content="語法錯誤" />
|
||||||
|
<meta name="generator" content="Selima 3.10" />
|
||||||
|
<link rel="start" type="application/xhtml+xml" href="/" />
|
||||||
|
<link rel="copyright" type="application/xhtml+xml" href="/copying.html" />
|
||||||
|
<link rel="author" href="mailto:emily6wu@ms27.hinet.net" />
|
||||||
|
<link rel="stylesheet" type="text/css" href="/stylesheets/common.css" />
|
||||||
|
<link rel="shortcut icon" type="image/x-icon" href="/favicon.ico" />
|
||||||
|
<title>HTTP 400 語法錯誤</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="/" title="回到吳芳美網站的首頁">首頁</a></span> |
|
||||||
|
<span><a href="/cgi-bin/guestbook.cgi" title="妳可以到這裏留言給吳芳美，我會儘快給妳回覆">留言板</a></span> |
|
||||||
|
<span><a href="/links/" title="這裏搜集了很多和旅遊相關的網站">相關連結</a></span> |
|
||||||
|
<span><a href="mailto:emily6wu@ms27.hinet.net" title="不要忘記寫 E-mail 給我喔！ ^_^"><em><acronym title="electronic mail" xml:lang="en">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><abbr title="HyperText Transfer Protocol">HTTP</abbr> 400 語法錯誤</h1>
|
||||||
|
|
||||||
|
<!-- errmsg -->
|
||||||
|
|
||||||
|
<p>很抱歉，妳的要求語法錯誤，網站看不懂妳的要求。這可能是瀏覽器的問題，或妳輸入的網址有筆誤。請更正妳的筆誤，或請回<a href="/">吳芳美網站首頁</a>重新瀏覽。</p>
|
||||||
|
|
||||||
|
<p>若有任何問題，請<a href="mailto:imacat@mail.imacat.idv.tw">來信告訴我們</a>。</p>
|
||||||
|
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<hr />
|
||||||
|
<div id="footer" class="footer" title="頁尾區">
|
||||||
|
<div>
|
||||||
|
<img class="pridetouricon" src="/images/pridetour" alt="尊貴假期" />
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<div>
|
||||||
|
吳芳美 Emily Wu<br />
|
||||||
|
金興旅行社 業務經理<br />
|
||||||
|
電話: (07) 311-3916 / 手機: (0933) 38-6779 / 傳真: (07) 311-4028<br />
|
||||||
|
地址: 高雄市三民區博愛一路 28 號 13 樓<br />
|
||||||
|
<acronym title="electronic mail">E-mail</acronym>: <a href="mailto:emily6wu@ms27.hinet.net">emily6wu@ms27.hinet.net</a><br />
|
||||||
|
網址: <a href="http://emily.imacat.idv.tw/">http://emily.imacat.idv.tw/</a><br />
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<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>版權所有 © 2000-2018 依瑪貓，欲轉載引用請先閱讀<a href="/copying.html">版權聲明</a>。</p>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
</div>
|
||||||
|
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
1
htdocs/emily/errors/401.html.html
Symbolic link
1
htdocs/emily/errors/401.html.html
Symbolic link
@@ -0,0 +1 @@
|
|||||||
|
401.html.xhtml
|
||||||
102
htdocs/emily/errors/401.html.xhtml
Normal file
102
htdocs/emily/errors/401.html.xhtml
Normal file
@@ -0,0 +1,102 @@
|
|||||||
|
<?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="© 2000-2018 依瑪貓。依瑪貓保有所有權利。" />
|
||||||
|
<meta name="keywords" content="非請莫入" />
|
||||||
|
<meta name="generator" content="Selima 3.10" />
|
||||||
|
<link rel="start" type="application/xhtml+xml" href="/" />
|
||||||
|
<link rel="copyright" type="application/xhtml+xml" href="/copying.html" />
|
||||||
|
<link rel="author" href="mailto:emily6wu@ms27.hinet.net" />
|
||||||
|
<link rel="stylesheet" type="text/css" href="/stylesheets/common.css" />
|
||||||
|
<link rel="shortcut icon" type="image/x-icon" href="/favicon.ico" />
|
||||||
|
<title>HTTP 401 非請莫入</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="/" title="回到吳芳美網站的首頁">首頁</a></span> |
|
||||||
|
<span><a href="/cgi-bin/guestbook.cgi" title="妳可以到這裏留言給吳芳美，我會儘快給妳回覆">留言板</a></span> |
|
||||||
|
<span><a href="/links/" title="這裏搜集了很多和旅遊相關的網站">相關連結</a></span> |
|
||||||
|
<span><a href="mailto:emily6wu@ms27.hinet.net" title="不要忘記寫 E-mail 給我喔！ ^_^"><em><acronym title="electronic mail" xml:lang="en">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><abbr title="HyperText Transfer Protocol">HTTP</abbr> 401 非請莫入</h1>
|
||||||
|
|
||||||
|
<p>很抱歉，本頁非請莫入，請回<a href="/">吳芳美網站首頁</a>重新瀏覽。</p>
|
||||||
|
|
||||||
|
<p>若有任何問題，請<a href="mailto:imacat@mail.imacat.idv.tw">來信告訴我們</a>。</p>
|
||||||
|
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<hr />
|
||||||
|
<div id="footer" class="footer" title="頁尾區">
|
||||||
|
<div>
|
||||||
|
<img class="pridetouricon" src="/images/pridetour" alt="尊貴假期" />
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<div>
|
||||||
|
吳芳美 Emily Wu<br />
|
||||||
|
金興旅行社 業務經理<br />
|
||||||
|
電話: (07) 311-3916 / 手機: (0933) 38-6779 / 傳真: (07) 311-4028<br />
|
||||||
|
地址: 高雄市三民區博愛一路 28 號 13 樓<br />
|
||||||
|
<acronym title="electronic mail">E-mail</acronym>: <a href="mailto:emily6wu@ms27.hinet.net">emily6wu@ms27.hinet.net</a><br />
|
||||||
|
網址: <a href="http://emily.imacat.idv.tw/">http://emily.imacat.idv.tw/</a><br />
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<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>版權所有 © 2000-2018 依瑪貓，欲轉載引用請先閱讀<a href="/copying.html">版權聲明</a>。</p>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
</div>
|
||||||
|
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
1
htdocs/emily/errors/403.html.html
Symbolic link
1
htdocs/emily/errors/403.html.html
Symbolic link
@@ -0,0 +1 @@
|
|||||||
|
403.html.xhtml
|
||||||
104
htdocs/emily/errors/403.html.xhtml
Normal file
104
htdocs/emily/errors/403.html.xhtml
Normal file
@@ -0,0 +1,104 @@
|
|||||||
|
<?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="© 2000-2018 依瑪貓。依瑪貓保有所有權利。" />
|
||||||
|
<meta name="keywords" content="禁止進入" />
|
||||||
|
<meta name="generator" content="Selima 3.10" />
|
||||||
|
<link rel="start" type="application/xhtml+xml" href="/" />
|
||||||
|
<link rel="copyright" type="application/xhtml+xml" href="/copying.html" />
|
||||||
|
<link rel="author" href="mailto:emily6wu@ms27.hinet.net" />
|
||||||
|
<link rel="stylesheet" type="text/css" href="/stylesheets/common.css" />
|
||||||
|
<link rel="shortcut icon" type="image/x-icon" href="/favicon.ico" />
|
||||||
|
<title>HTTP 403 禁止進入</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="/" title="回到吳芳美網站的首頁">首頁</a></span> |
|
||||||
|
<span><a href="/cgi-bin/guestbook.cgi" title="妳可以到這裏留言給吳芳美，我會儘快給妳回覆">留言板</a></span> |
|
||||||
|
<span><a href="/links/" title="這裏搜集了很多和旅遊相關的網站">相關連結</a></span> |
|
||||||
|
<span><a href="mailto:emily6wu@ms27.hinet.net" title="不要忘記寫 E-mail 給我喔！ ^_^"><em><acronym title="electronic mail" xml:lang="en">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><abbr title="HyperText Transfer Protocol">HTTP</abbr> 403 禁止進入</h1>
|
||||||
|
|
||||||
|
<!-- errmsg -->
|
||||||
|
|
||||||
|
<p>很抱歉，本頁禁止進入，請回<a href="/">吳芳美網站首頁</a>重新瀏覽。</p>
|
||||||
|
|
||||||
|
<p>若有任何問題，請<a href="mailto:imacat@mail.imacat.idv.tw">來信告訴我們</a>。</p>
|
||||||
|
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<hr />
|
||||||
|
<div id="footer" class="footer" title="頁尾區">
|
||||||
|
<div>
|
||||||
|
<img class="pridetouricon" src="/images/pridetour" alt="尊貴假期" />
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<div>
|
||||||
|
吳芳美 Emily Wu<br />
|
||||||
|
金興旅行社 業務經理<br />
|
||||||
|
電話: (07) 311-3916 / 手機: (0933) 38-6779 / 傳真: (07) 311-4028<br />
|
||||||
|
地址: 高雄市三民區博愛一路 28 號 13 樓<br />
|
||||||
|
<acronym title="electronic mail">E-mail</acronym>: <a href="mailto:emily6wu@ms27.hinet.net">emily6wu@ms27.hinet.net</a><br />
|
||||||
|
網址: <a href="http://emily.imacat.idv.tw/">http://emily.imacat.idv.tw/</a><br />
|
||||||
|
</div>
|
||||||
|
|
||||||
|
<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>版權所有 © 2000-2018 依瑪貓，欲轉載引用請先閱讀<a href="/copying.html">版權聲明</a>。</p>
|
||||||
|
</div>
|
||||||
|
|
||||||
|
</div>
|
||||||
|
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
1
htdocs/emily/errors/404.html.html
Symbolic link
1
htdocs/emily/errors/404.html.html
Symbolic link
@@ -0,0 +1 @@
|
|||||||
|
404.html.xhtml
|
||||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user