753 lines
24 KiB
Perl
753 lines
24 KiB
Perl
# 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;
|