Initial commit.
This commit is contained in:
70
htdocs/htc/magicat/lib/perl5/Selima/htc.pm
Normal file
70
htdocs/htc/magicat/lib/perl5/Selima/htc.pm
Normal file
@@ -0,0 +1,70 @@
|
||||
# History: Theory and Culture
|
||||
# htc.pm: History: Theory and Culture
|
||||
|
||||
# Copyright (c) 2003-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2003-04-06
|
||||
|
||||
package Selima::htc;
|
||||
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::htc::Config;
|
||||
push @EXPORT, @Selima::htc::Config::EXPORT;
|
||||
use Selima::htc::DataVars qw(:all);
|
||||
push @EXPORT, @Selima::htc::DataVars::EXPORT_OK;
|
||||
use Selima::htc::HTML;
|
||||
push @EXPORT, @Selima::htc::HTML::EXPORT;
|
||||
use Selima::htc::Items;
|
||||
push @EXPORT, @Selima::htc::Items::EXPORT;
|
||||
use Selima::htc::Rebuild;
|
||||
push @EXPORT, @Selima::htc::Rebuild::EXPORT;
|
||||
|
||||
# Import our site-specific classess
|
||||
use Selima::htc::Checker::Guestbook;
|
||||
use Selima::htc::Checker::Guestbook::Public;
|
||||
use Selima::htc::Checker::Newslet;
|
||||
use Selima::htc::Checker::NLIndex;
|
||||
use Selima::htc::Checker::NLArt;
|
||||
use Selima::htc::Form::Guestbook;
|
||||
use Selima::htc::Form::Guestbook::Public;
|
||||
use Selima::htc::Form::Newslet;
|
||||
use Selima::htc::Form::NLIndex;
|
||||
use Selima::htc::Form::NLArt;
|
||||
use Selima::htc::L10N;
|
||||
use Selima::htc::List::Guestbook;
|
||||
use Selima::htc::List::Guestbook::Public;
|
||||
use Selima::htc::List::Newslets;
|
||||
use Selima::htc::List::NLIndex;
|
||||
use Selima::htc::List::NLArts;
|
||||
use Selima::htc::List::Search;
|
||||
use Selima::htc::Processor::Guestbook::Public;
|
||||
use Selima::htc::Processor::Newslet;
|
||||
use Selima::htc::Processor::NLIndex;
|
||||
use Selima::htc::Processor::NLArt;
|
||||
|
||||
# Import our common modules
|
||||
use Selima;
|
||||
push @EXPORT, @Selima::EXPORT;
|
||||
|
||||
@EXPORT_OK = @EXPORT;
|
||||
|
||||
return 1;
|
||||
54
htdocs/htc/magicat/lib/perl5/Selima/htc/Checker/Guestbook.pm
Normal file
54
htdocs/htc/magicat/lib/perl5/Selima/htc/Checker/Guestbook.pm
Normal file
@@ -0,0 +1,54 @@
|
||||
# History: Theory and Culture
|
||||
# Guestbook.pm: The administrative guestbook form checker.
|
||||
|
||||
# Copyright (c) 2004-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2004-10-24
|
||||
|
||||
package Selima::htc::Checker::Guestbook;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Checker::Guestbook);
|
||||
|
||||
use Selima::ShortCut;
|
||||
|
||||
# _check_name: Check the name
|
||||
sub _check_name : method {
|
||||
# Run the parent checker
|
||||
return $_[0]->SUPER::_check_name_req;
|
||||
}
|
||||
|
||||
# _check_identity: Check the identity
|
||||
sub _check_identity : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $error);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
# Check if it exists
|
||||
$error = $self->_missing("identity");
|
||||
return $error if defined $error;
|
||||
# Regularize it
|
||||
$self->_trim("identity");
|
||||
# Check the length
|
||||
return {"msg"=>N_("This occupation is too long. (Max. length [#,_1])"),
|
||||
"margs"=>[${$self->{"maxlens"}}{"identity"}]}
|
||||
if length $form->param("identity") > ${$self->{"maxlens"}}{"identity"};
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
return 1;
|
||||
@@ -0,0 +1,57 @@
|
||||
# History: Theory and Culture
|
||||
# Public.pm: The guestbook form checker.
|
||||
|
||||
# Copyright (c) 2004-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2004-10-24
|
||||
|
||||
package Selima::htc::Checker::Guestbook::Public;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Checker::Guestbook::Public);
|
||||
|
||||
use Selima::DataVars qw($DBH);
|
||||
use Selima::HTTP;
|
||||
use Selima::Logging;
|
||||
use Selima::ShortCut;
|
||||
|
||||
# _check_name: Check the name
|
||||
sub _check_name : method {
|
||||
# Run the parent checker
|
||||
return $_[0]->SUPER::_check_name_req;
|
||||
}
|
||||
|
||||
# _check_identity: Check the identity
|
||||
sub _check_identity : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $error);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
# Check if it exists
|
||||
$error = $self->_missing("identity");
|
||||
return $error if defined $error;
|
||||
# Regularize it
|
||||
$self->_trim("identity");
|
||||
# Check the length
|
||||
return {"msg"=>N_("Your occupation is too long. (Max. length [#,_1])"),
|
||||
"margs"=>[${$self->{"maxlens"}}{"identity"}]}
|
||||
if length $form->param("identity") > ${$self->{"maxlens"}}{"identity"};
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
return 1;
|
||||
205
htdocs/htc/magicat/lib/perl5/Selima/htc/Checker/NLArt.pm
Normal file
205
htdocs/htc/magicat/lib/perl5/Selima/htc/Checker/NLArt.pm
Normal file
@@ -0,0 +1,205 @@
|
||||
# History: Theory and Culture
|
||||
# NLArt.pm: The newsletter 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-04-30
|
||||
|
||||
package Selima::htc::Checker::NLArt;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Checker);
|
||||
|
||||
use Email::Valid;
|
||||
|
||||
use Selima::CallForm;
|
||||
use Selima::ChkFunc;
|
||||
use Selima::ShortCut;
|
||||
|
||||
use Selima::htc::DataVars qw(:forms);
|
||||
|
||||
# new: Initialize the checker
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($class, $self);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "nlarts" if scalar(@_) < 2 || !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _check_annots: Check the annotations
|
||||
sub _check_annots : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $error);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
# Check if it exists
|
||||
$error = $self->_missing("annots");
|
||||
return $error if defined $error;
|
||||
# Regularize it
|
||||
$self->_trimtext("annots");
|
||||
# Skip if it is not filled
|
||||
$form->param("annots", "")
|
||||
if $form->param("annots") eq __("Fill in the annotations here.");
|
||||
return if $form->param("annots") eq "";
|
||||
# Check the length
|
||||
return {"msg"=>N_("This annotations list is too long. (Max. length [#,_1])"),
|
||||
"margs"=>[${$self->{"maxlens"}}{"annots"}]}
|
||||
if length $form->param("annots") > ${$self->{"maxlens"}}{"annots"};
|
||||
# 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_authors: Check the authors column
|
||||
sub _check_authors : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $error);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
# Check if it exists
|
||||
$error = $self->_missing("authors");
|
||||
return $error if defined $error;
|
||||
# Regularize it
|
||||
$self->_trimtext("authors");
|
||||
# Skip if it is not filled
|
||||
$form->param("authors", "")
|
||||
if $form->param("authors") eq __("Fill in the authors column here.");
|
||||
return if $form->param("authors") eq "";
|
||||
# Check the length
|
||||
return {"msg"=>N_("This authors column is too long. (Max. length [#,_1])"),
|
||||
"margs"=>[${$self->{"maxlens"}}{"authors"}]}
|
||||
if length $form->param("authors") > ${$self->{"maxlens"}}{"authors"};
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# _check_body: Check the content
|
||||
# Use the default content checker
|
||||
|
||||
# _check_email: Check the e-mail
|
||||
sub _check_email : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $error);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
# Check if it exists
|
||||
$error = $self->_missing("email");
|
||||
return $error if defined $error;
|
||||
# Regularize it
|
||||
$self->_trim("email");
|
||||
# Skip if it is not filled
|
||||
return if $form->param("email") eq "";
|
||||
# Check the length
|
||||
return {"msg"=>N_("This e-mail is too long. (Max. length [#,_1])"),
|
||||
"margs"=>[${$self->{"maxlens"}}{"email"}]}
|
||||
if length $form->param("email") > ${$self->{"maxlens"}}{"email"};
|
||||
# Check the e-mail validity
|
||||
return {"msg"=>N_("Please fill in a valid e-mail address.")}
|
||||
if !Email::Valid->rfc822($form->param("email"));
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# _check_newslet: Check the newsletter
|
||||
sub _check_newslet : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $error);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
# Check if it exists
|
||||
$error = $self->_missing("newslet");
|
||||
return $error if defined $error;
|
||||
# Regularize it
|
||||
$self->_trim("newslet");
|
||||
# Check if it is filled
|
||||
return {"msg"=>N_("Please select a newsletter.")}
|
||||
if $form->param("newslet") eq "";
|
||||
# Check if the newsletter exists
|
||||
return {"msg"=>N_("This newsletter does not exist anymore. Please select another one.")}
|
||||
if !check_sn_in ${$form->param_fetch("newslet")}[0], "newslets";
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# _check_title: Check the title
|
||||
# Use the default title checker
|
||||
|
||||
# _check_title_h: Check the HTML title
|
||||
sub _check_title_h : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $error);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
# Check if it exists
|
||||
$error = $self->_missing("title_h");
|
||||
return $error if defined $error;
|
||||
# Regularize it
|
||||
$self->_trim("title_h");
|
||||
# Skip if it is not filled
|
||||
return if $form->param("title_h") eq "";
|
||||
# Check the length
|
||||
return {"msg"=>N_("This HTML title is too long. (Max. length [#,_1])"),
|
||||
"margs"=>[${$self->{"maxlens"}}{"title_h"}]}
|
||||
if length $form->param("title_h") > ${$self->{"maxlens"}}{"title_h"};
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# _redir_selnewslet: Suspend and move to the newsletter selection form
|
||||
sub _redir_selnewslet : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Skip if not requested
|
||||
return if $self->_missing("selnewslet");
|
||||
call_form FORM_NEWSLETS, undef, "import_selnewslet";
|
||||
}
|
||||
|
||||
# _redir_delnewslet: Remove the newsletter
|
||||
sub _redir_delnewslet : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Skip if not requested
|
||||
return if $self->_missing("delnewslet");
|
||||
$self->{"form"}->delete("newslet");
|
||||
success_redirect undef;
|
||||
}
|
||||
|
||||
return 1;
|
||||
200
htdocs/htc/magicat/lib/perl5/Selima/htc/Checker/NLIndex.pm
Normal file
200
htdocs/htc/magicat/lib/perl5/Selima/htc/Checker/NLIndex.pm
Normal file
@@ -0,0 +1,200 @@
|
||||
# History: Theory and Culture
|
||||
# NLIndex.pm: The newsletter index 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-04-29
|
||||
|
||||
package Selima::htc::Checker::NLIndex;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Checker);
|
||||
|
||||
use Selima::CallForm;
|
||||
use Selima::ChkFunc;
|
||||
use Selima::DataVars qw($DBH :forms);
|
||||
use Selima::ShortCut;
|
||||
|
||||
use Selima::htc::DataVars qw(:forms);
|
||||
|
||||
# new: Initialize the checker
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($class, $self);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "nlindex" if scalar(@_) < 2 || !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
${$self->{"maxlens"}}{"ord"} = 2;
|
||||
${$self->{"minlens"}}{"id"} = 2;
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _check_newslet: Check the newsletter
|
||||
sub _check_newslet : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $error);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
# Check if it exists
|
||||
$error = $self->_missing("newslet");
|
||||
return $error if defined $error;
|
||||
# Regularize it
|
||||
$self->_trim("newslet");
|
||||
# Check if it is filled
|
||||
return {"msg"=>N_("Please select a newsletter.")}
|
||||
if $form->param("newslet") eq "";
|
||||
# Check if the newsletter exists
|
||||
return {"msg"=>N_("This newsletter does not exist anymore. Please select another one.")}
|
||||
if !check_sn_in ${$form->param_fetch("newslet")}[0], "newslets";
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# _check_parent: Check the parent index item
|
||||
sub _check_parent : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $error, $sth, $sql);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
# "topmost not set" has a different form context
|
||||
return {"msg"=>N_("Please select a parent index item.")}
|
||||
if $self->_missing("topmost");
|
||||
# Regularize it
|
||||
$self->_trim("topmost");
|
||||
# Check the option value
|
||||
return {"msg"=>N_("This option is invalid. Please select a proper parent index item.")}
|
||||
unless $form->param("topmost") =~ /^(?:true|false)$/;
|
||||
# Check the parent index item if not a topmost index item
|
||||
if ($form->param("topmost") eq "false") {
|
||||
# Check if it exists
|
||||
$error = $self->_missing("parent");
|
||||
return $error if defined $error;
|
||||
# Regularize it
|
||||
$self->_trim("parent");
|
||||
# Check if it is filled
|
||||
return {"msg"=>N_("Please select a parent index item.")}
|
||||
if $form->param("parent") eq "";
|
||||
# Check if this index item exists
|
||||
return {"msg"=>N_("This parent index item does not exist anymore. Please select another one.")}
|
||||
if !check_sn_in ${$form->param_fetch("parent")}[0], "nlindex";
|
||||
if ($self->{"iscur"}) {
|
||||
# Check if the parent index item is itself
|
||||
return {"msg"=>N_("An index item cannot belong to itself. Please select another one.")}
|
||||
if $form->param("parent") == $self->{"sn"};
|
||||
# Check if the parent directory is its descendant
|
||||
$sql = "SELECT nlindex_ischild(" . $self->{"sn"} . ", "
|
||||
. $form->param("parent") . ") AS is_child;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
return {"msg"=>N_("An index item cannot belong to its descendant. Please select another one.")}
|
||||
if ${$sth->fetchrow_hashref}{"is_child"};
|
||||
}
|
||||
}
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# _check_art: Check the article
|
||||
sub _check_art : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $error);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
# Check if it exists
|
||||
$error = $self->_missing("art");
|
||||
return $error if defined $error;
|
||||
# Regularize it
|
||||
$self->_trim("art");
|
||||
# Skip if it is not filled
|
||||
return if $form->param("art") eq "";
|
||||
# Check if the article exists
|
||||
return {"msg"=>N_("This article does not exist anymore. Please select another one.")}
|
||||
if !check_sn_in ${$form->param_fetch("art")}[0], "nlarts";
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# _check_title: The default title checker
|
||||
sub _check_title : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $error);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
# Check if it exists
|
||||
$error = $self->_missing("title");
|
||||
return $error if defined $error;
|
||||
# Regularize it
|
||||
$self->_trim("title");
|
||||
# Check if it is filled
|
||||
if ($form->param("title") eq "") {
|
||||
# Title must be filled if there is no article
|
||||
return {"msg"=>N_("Please fill in the title.")}
|
||||
if !defined $form->param("art") || $form->param("art") eq "";
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
# Check the length
|
||||
return {"msg"=>N_("This title is too long. (Max. length [#,_1])"),
|
||||
"margs"=>[${$self->{"maxlens"}}{"title"}]}
|
||||
if length $form->param("title") > ${$self->{"maxlens"}}{"title"};
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# _redir_selnewslet: Suspend and move to the newsletter selection form
|
||||
sub _redir_selnewslet : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Skip if not requested
|
||||
return if $self->_missing("selnewslet");
|
||||
call_form FORM_NEWSLETS, undef, "import_selnewslet";
|
||||
}
|
||||
|
||||
# _redir_delnewslet: Remove the newsletter
|
||||
sub _redir_delnewslet : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Skip if not requested
|
||||
return if $self->_missing("delnewslet");
|
||||
$self->{"form"}->delete("newslet");
|
||||
success_redirect undef;
|
||||
}
|
||||
|
||||
# _redir_selart: Suspend and move to the article selection form
|
||||
sub _redir_selart : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Skip if not requested
|
||||
return if $self->_missing("selart");
|
||||
call_form FORM_NLARTS, undef, "import_selart";
|
||||
}
|
||||
|
||||
# _redir_delart: Remove the article
|
||||
sub _redir_delart : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Skip if not requested
|
||||
return if $self->_missing("delart");
|
||||
$self->{"form"}->delete("art");
|
||||
success_redirect undef;
|
||||
}
|
||||
|
||||
return 1;
|
||||
140
htdocs/htc/magicat/lib/perl5/Selima/htc/Checker/Newslet.pm
Normal file
140
htdocs/htc/magicat/lib/perl5/Selima/htc/Checker/Newslet.pm
Normal file
@@ -0,0 +1,140 @@
|
||||
# History: Theory and Culture
|
||||
# Newslet.pm: The newsletter 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-04-28
|
||||
|
||||
package Selima::htc::Checker::Newslet;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Checker);
|
||||
|
||||
use CGI qw();
|
||||
|
||||
use Selima::CallForm;
|
||||
use Selima::ChkFunc;
|
||||
use Selima::DataVars qw(:dataman);
|
||||
use Selima::ShortCut;
|
||||
|
||||
use Selima::htc::DataVars qw(:forms);
|
||||
use Selima::htc::Items;
|
||||
|
||||
# new: Initialize the checker
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($class, $self);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "newslets" if scalar(@_) < 2 || !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _check_no: Check the issue number
|
||||
# Actually this is to set the issue number, but not to check it
|
||||
sub _check_no : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Current form
|
||||
if ($self->{"iscur"}) {
|
||||
$self->{"form"}->param("no", $CURRENT{"no"});
|
||||
return;
|
||||
}
|
||||
# Create a new issue for this new newsletter
|
||||
$self->{"form"}->param("no", new_nl_no);
|
||||
return;
|
||||
}
|
||||
|
||||
# _check_date: Check the date
|
||||
sub _check_date : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $error);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
# Check if it exists
|
||||
$error = $self->_missing("date");
|
||||
return $error if defined $error;
|
||||
# Regularize it
|
||||
$self->_trim("date");
|
||||
# Check if it is filled
|
||||
return {"msg"=>N_("Please fill in the date.")}
|
||||
if $form->param("date") eq "";
|
||||
# Check the length
|
||||
return {"msg"=>N_("Please fill in a valid date in YYYY-MM-DD format.")}
|
||||
if length $form->param("date") != ${$self->{"maxlens"}}{"date"};
|
||||
# Check the date format
|
||||
return {"msg"=>N_("Please fill in a valid date in YYYY-MM-DD format.")}
|
||||
if length $form->param("date") !~ /^(\d{4})-(\d{2})-(\d{2})$/;
|
||||
return {"msg"=>N_("Please fill in a valid date in YYYY-MM-DD format.")}
|
||||
unless defined check_date($1, $2, $3);
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# _check_credits: Check the credits
|
||||
sub _check_credits : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $error);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
# Check if it exists
|
||||
$error = $self->_missing("credits");
|
||||
return $error if defined $error;
|
||||
# Regularize it
|
||||
$self->_trimtext("credits");
|
||||
# Skip if it is not filled
|
||||
return if $form->param("credits") eq "";
|
||||
# Check the length
|
||||
return {"msg"=>N_("This credits information is too long. (Max. length [#,_1])"),
|
||||
"margs"=>[${$self->{"maxlens"}}{"credits"}]}
|
||||
if length $form->param("credits") > ${$self->{"maxlens"}}{"credits"};
|
||||
# OK
|
||||
return;
|
||||
}
|
||||
|
||||
# _redir_selndxart: Suspend and move to the index item article selection form
|
||||
sub _redir_selndxart : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
# Skip if not requested
|
||||
@_ = grep /^selndx\d+(?:sub\d+)*art$/, sort $form->param;
|
||||
return if @_ == 0;
|
||||
$_ = $_[0];
|
||||
s/^sel//;
|
||||
$form->param("caller_index", $_);
|
||||
call_form FORM_NLARTS, undef, "import_selndxart";
|
||||
}
|
||||
|
||||
# _redir_delndxart: Remove the index item article
|
||||
sub _redir_delndxart : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
# Skip if not requested
|
||||
@_ = grep /^delndx\d+(?:sub\d+)*art$/, sort $form->param;
|
||||
return if @_ == 0;
|
||||
$_ = $_[0];
|
||||
s/^del//;
|
||||
$form->delete($_);
|
||||
success_redirect undef;
|
||||
}
|
||||
|
||||
return 1;
|
||||
90
htdocs/htc/magicat/lib/perl5/Selima/htc/Config.pm
Normal file
90
htdocs/htc/magicat/lib/perl5/Selima/htc/Config.pm
Normal file
@@ -0,0 +1,90 @@
|
||||
# History: Theory and Culture
|
||||
# Config.pm: The web site configuration.
|
||||
|
||||
# Copyright (c) 2003-2020 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2003-04-06
|
||||
|
||||
package Selima::htc::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::htc::DataVars qw(:all);
|
||||
|
||||
# siteconf: Subroutine to initialize site configuration
|
||||
sub siteconf() {
|
||||
local ($_, %_);
|
||||
|
||||
# The package name and the package title
|
||||
$PACKAGE = "htc";
|
||||
$SITENAME_ABBR = "HTC";
|
||||
# The author and the copyright
|
||||
$AUTHOR = "依瑪貓";
|
||||
$COPYRIGHT = "© <!--selima:copyyear--> 歷史：理論與文化編輯群。歷史：理論與文化編輯群保有所有權利。";
|
||||
# Document root, the library and the l10n directories
|
||||
$DOC_ROOT = $ENV{"DOCUMENT_ROOT"};
|
||||
$SITE_LIBDIR = $DOC_ROOT . "/magicat/lib/perl5";
|
||||
$LOCALEDIR = $DOC_ROOT . "/magicat/locale";
|
||||
|
||||
# Tables to lock when rebuilding pages
|
||||
@REBUILD_TABLES = qw(linkcat links linkcatz);
|
||||
|
||||
# The languages
|
||||
$DEFAULT_LANG = "zh-tw";
|
||||
@ALL_LINGUAS = qw(zh-tw);
|
||||
|
||||
# The site data variables
|
||||
$SCRIPTS{FORM_NEWSLETS()} = "/magicat/cgi-bin/newslets.cgi",
|
||||
$SCRIPTS{FORM_NLINDEX()} = "/magicat/cgi-bin/nlindex.cgi",
|
||||
$SCRIPTS{FORM_NLARTS()} = "/magicat/cgi-bin/nlarts.cgi",
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
# page_replacements: Dynamic page elements to be replaced,
|
||||
# but not part of the content. Used by xfupdate_template().
|
||||
sub page_replacements() {
|
||||
return {
|
||||
"copyyear" => {
|
||||
"pattern" => "2000(?:-\\d{4})?",
|
||||
"content" => copyyear(2000),
|
||||
},
|
||||
"generator" => {
|
||||
"pattern" => "Selima \\d+\\.\\d+",
|
||||
"content" => "Selima $Selima::VERSION",
|
||||
},
|
||||
};
|
||||
}
|
||||
|
||||
no utf8;
|
||||
return 1;
|
||||
60
htdocs/htc/magicat/lib/perl5/Selima/htc/DataVars.pm
Normal file
60
htdocs/htc/magicat/lib/perl5/Selima/htc/DataVars.pm
Normal file
@@ -0,0 +1,60 @@
|
||||
# History: Theory and Culture
|
||||
# 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-04-29
|
||||
|
||||
package Selima::htc::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(FORM_NEWSLETS FORM_NLINDEX FORM_NLARTS)],
|
||||
);
|
||||
@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);
|
||||
|
||||
use constant FORM_NEWSLETS => 1001;
|
||||
use constant FORM_NLINDEX => 1002;
|
||||
use constant FORM_NLARTS => 1003;
|
||||
|
||||
# clear: Clear the data variables
|
||||
sub clear() {
|
||||
local ($_, %_);
|
||||
|
||||
delete $SCRIPTS{FORM_NEWSLETS()};
|
||||
delete $SCRIPTS{FORM_NLINDEX()};
|
||||
delete $SCRIPTS{FORM_NLARTS()};
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
return 1;
|
||||
40
htdocs/htc/magicat/lib/perl5/Selima/htc/Form/Guestbook.pm
Normal file
40
htdocs/htc/magicat/lib/perl5/Selima/htc/Form/Guestbook.pm
Normal file
@@ -0,0 +1,40 @@
|
||||
# History: Theory and Culture
|
||||
# Guestbook.pm: The administrative guestbook form.
|
||||
|
||||
# Copyright (c) 2004-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2004-10-24
|
||||
|
||||
package Selima::htc::Form::Guestbook;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Form::Guestbook);
|
||||
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
|
||||
# _html_col_identity: The identity
|
||||
sub _html_col_identity : method {
|
||||
$_[0]->_html_coltmpl_text("identity", h_abbr(__("Occupation:")));
|
||||
}
|
||||
|
||||
# _html_col_url: The website URL
|
||||
sub _html_col_url : method {
|
||||
$_[0]->_html_coltmpl_url("url", h_abbr(__("Website URL.:")));
|
||||
}
|
||||
|
||||
return 1;
|
||||
@@ -0,0 +1,62 @@
|
||||
# History: Theory and Culture
|
||||
# Public.pm: The guestbook form.
|
||||
|
||||
# Copyright (c) 2004-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2004-10-24
|
||||
|
||||
package Selima::htc::Form::Guestbook::Public;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Form::Guestbook::Public);
|
||||
|
||||
use Selima::HTTP;
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
|
||||
# _html_col_email: The e-mail
|
||||
sub _html_col_email : method {
|
||||
$_[0]->_html_coltmpl_text("email", h_abbr(__("E-mail")));
|
||||
}
|
||||
|
||||
# _html_col_identity: The identity
|
||||
sub _html_col_identity : method {
|
||||
$_[0]->_html_coltmpl_text("identity", h_abbr(__("Occupation")));
|
||||
}
|
||||
|
||||
# _html_col_location: The location
|
||||
sub _html_col_location : method {
|
||||
$_[0]->_html_coltmpl_text("location", h_abbr(__("Location")));
|
||||
}
|
||||
|
||||
# _html_col_message: The message
|
||||
sub _html_col_message : method {
|
||||
$_[0]->_html_coltmpl_textarea("message", h_abbr(__("Message")),
|
||||
h_abbr(__("Fill in your message here.")));
|
||||
}
|
||||
|
||||
# _html_col_name: The name
|
||||
sub _html_col_name : method {
|
||||
$_[0]->_html_coltmpl_text("name", h_abbr(__("Signature")));
|
||||
}
|
||||
|
||||
# _html_col_url: The website URL
|
||||
sub _html_col_url : method {
|
||||
$_[0]->_html_coltmpl_url("url", h_abbr(__("Website URL.")));
|
||||
}
|
||||
|
||||
return 1;
|
||||
124
htdocs/htc/magicat/lib/perl5/Selima/htc/Form/NLArt.pm
Normal file
124
htdocs/htc/magicat/lib/perl5/Selima/htc/Form/NLArt.pm
Normal file
@@ -0,0 +1,124 @@
|
||||
# History: Theory and Culture
|
||||
# NLArt.pm: The newsletter 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-04-29
|
||||
|
||||
package Selima::htc::Form::NLArt;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Form);
|
||||
|
||||
use Selima::CommText;
|
||||
use Selima::DataVars qw(:dataman :requri);
|
||||
use Selima::FormFunc;
|
||||
use Selima::HTTP;
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
|
||||
use Selima::htc::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"} = "nlarts"
|
||||
if !exists $$args{"table"};
|
||||
$$args{"deltext"} = __("Delete this article")
|
||||
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 article.");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"summary"} = __("This table provides you a form to edit a current article.");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"summary"} = __("This table provides you a form to delete a article.");
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"cols"}) {
|
||||
# A form to create a new item
|
||||
if ($$args{"type"} eq "new") {
|
||||
$$args{"cols"} = [qw(newslet ord title title_h author
|
||||
email authors body annots kw 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 newslet ord title title_h author
|
||||
email authors body annots kw html hid
|
||||
created createdby updated updatedby)];
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"title"}) {
|
||||
# A form to create a new item
|
||||
if ($$args{"type"} eq "new") {
|
||||
$$args{"title"} = __("Add a New Newsletter Article");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"title"} = __("Edit a Current Newsletter Article");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"title"} = __("Delete a Newsletter Article");
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"preview"}) {
|
||||
$$args{"preview"} = 1;
|
||||
}
|
||||
if ($$args{"preview"} && !exists $$args{"prevmsg"}) {
|
||||
$$args{"prevmsg"} = __("Preview this article.");
|
||||
}
|
||||
$self = $class->SUPER::new($status, $args);
|
||||
${$self->{"maxlens"}}{"ord"} = 2;
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _html_col_newslet: The newsletter
|
||||
sub _html_col_newslet : method {
|
||||
$_[0]->_html_coltmpl_call("newslet", h_abbr(__("Newsletter:")), \&newslet_title);
|
||||
}
|
||||
|
||||
# _html_col_title_h: The HTML title
|
||||
sub _html_col_title_h : method {
|
||||
$_[0]->_html_coltmpl_text("title_h", h_abbr(__("HTML title:")),
|
||||
h_abbr(__("(Leave it blank if the same as the title.)")));
|
||||
}
|
||||
|
||||
# _html_col_authors: The authors column
|
||||
sub _html_col_authors : method {
|
||||
$_[0]->_html_coltmpl_textarea("authors", h_abbr(__("Authors column:")),
|
||||
h_abbr(__("Fill in the authors column here.")),
|
||||
h_abbr(__("(Leave it blank if the same as the author.)")), 3);
|
||||
}
|
||||
|
||||
# _html_col_annots: The annotations
|
||||
sub _html_col_annots : method {
|
||||
$_[0]->_html_coltmpl_textarea("annots", h_abbr(__("Annotations:")),
|
||||
h_abbr(__("Fill in the annotations here.")));
|
||||
}
|
||||
|
||||
return 1;
|
||||
152
htdocs/htc/magicat/lib/perl5/Selima/htc/Form/NLIndex.pm
Normal file
152
htdocs/htc/magicat/lib/perl5/Selima/htc/Form/NLIndex.pm
Normal file
@@ -0,0 +1,152 @@
|
||||
# History: Theory and Culture
|
||||
# NLIndex.pm: The newsletter index 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-04-29
|
||||
|
||||
package Selima::htc::Form::NLIndex;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Form);
|
||||
|
||||
use Selima::CommText;
|
||||
use Selima::DataVars qw(:requri);
|
||||
use Selima::FormFunc;
|
||||
use Selima::HTTP;
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
|
||||
use Selima::htc::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"} = "nlindex"
|
||||
if !exists $$args{"table"};
|
||||
$$args{"deltext"} = __("Delete this index item")
|
||||
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 index item.");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"summary"} = __("This table provides you a form to edit a current index item.");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"summary"} = __("This table provides you a form to delete a index item.");
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"cols"}) {
|
||||
# A form to create a new item
|
||||
if ($$args{"type"} eq "new") {
|
||||
$$args{"cols"} = [qw(newslet parent ord art 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 newslet parent ord art title subitems
|
||||
created createdby updated updatedby)];
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"title"}) {
|
||||
# A form to create a new item
|
||||
if ($$args{"type"} eq "new") {
|
||||
$$args{"title"} = __("Add a New Newsletter Index Item");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"title"} = __("Edit a Current Newsletter Index Item");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"title"} = __("Delete a Newsletter Index Item");
|
||||
}
|
||||
}
|
||||
$self = $class->SUPER::new($status, $args);
|
||||
${$self->{"maxlens"}}{"ord"} = 2;
|
||||
if ($self->{"type"} eq "cur") {
|
||||
if (defined $self->{"cur"}->param("subitemcount") && $self->{"cur"}->param("subitemcount") > 0) {
|
||||
$self->{"nodelete"} = 1;
|
||||
push @{$self->{"prefmsg"}}, __("This index item has [numerate,_1,a subitem,subitems]. It cannot be deleted. To delete the index item, [numerate,_1,its subitem,all of its subitems] must first be deleted.", $self->{"cur"}->param("subitemcount"));
|
||||
}
|
||||
}
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _html_col_art: The article
|
||||
sub _html_col_art : method {
|
||||
$_[0]->_html_coltmpl_call("art", h_abbr(__("Article:")), \&nlart_title);
|
||||
}
|
||||
|
||||
# _html_col_newslet: The newsletter
|
||||
sub _html_col_newslet : method {
|
||||
$_[0]->_html_coltmpl_call("newslet", h_abbr(__("Newsletter:")), \&newslet_title);
|
||||
}
|
||||
|
||||
# _html_col_parent: The parent
|
||||
sub _html_col_parent : method {
|
||||
$_[0]->_html_coltmpl_call_null("parent", h_abbr(__("Parent item:")),
|
||||
"topmost", h_abbr(__("At the very top")), \&nlindex_title);
|
||||
}
|
||||
|
||||
# _html_col_subitems: The subitems
|
||||
sub _html_col_subitems : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $current, $label, $url, $mark, $colspan, $thclass, $thcolspan);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
$current = $self->{"cur"};
|
||||
$mark = $self->_mark("subitems");
|
||||
$colspan = $self->_colspan;
|
||||
$label = h_abbr(__("[numerate,_1,Subitem,Subitems]:", $current->param("subitemcount")));
|
||||
# A current form span for 2 columns
|
||||
$thclass = $self->{"type"} ne "cur"? " class=\"th\"": "";
|
||||
$thcolspan = $self->{"type"} eq "cur"? " colspan=\"2\"": "";
|
||||
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th$thclass$thcolspan scope="row">$mark$label</th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
@_ = qw();
|
||||
for ($_ = 0; $_ < $current->param("subitemcount"); $_++) {
|
||||
push @_, sprintf " <li><a href=\"%s\">%s</a></li>\n",
|
||||
h($REQUEST_FILE . "?form=cur&sn=" . $current->param("subitem$_" . "sn")),
|
||||
$self->_cval_text("subitem$_" . "title");
|
||||
}
|
||||
print @_ > 0? "<ol>" . join("", @_) . " </ol>\n ": h_abbr(t_none);
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
|
||||
# _html_col_title: The title
|
||||
sub _html_col_title : method {
|
||||
$_[0]->_html_coltmpl_text("title", h_abbr(__("Title:")),
|
||||
h_abbr(__("(Leave it blank if the same as the article title.)")));
|
||||
}
|
||||
|
||||
return 1;
|
||||
396
htdocs/htc/magicat/lib/perl5/Selima/htc/Form/Newslet.pm
Normal file
396
htdocs/htc/magicat/lib/perl5/Selima/htc/Form/Newslet.pm
Normal file
@@ -0,0 +1,396 @@
|
||||
# History: Theory and Culture
|
||||
# Newslet.pm: The newsletter 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-04-28
|
||||
|
||||
package Selima::htc::Form::Newslet;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Form);
|
||||
|
||||
use CGI qw();
|
||||
|
||||
use Selima::CallForm;
|
||||
use Selima::CommText;
|
||||
use Selima::FormFunc;
|
||||
use Selima::HTTP;
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::ShortCut;
|
||||
|
||||
use Selima::htc::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"} = "newslets"
|
||||
if !exists $$args{"table"};
|
||||
$$args{"deltext"} = __("Delete this newsletter")
|
||||
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 newsletter.");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"summary"} = __("This table provides you a form to edit a current newsletter.");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"summary"} = __("This table provides you a form to delete a newsletter.");
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"cols"}) {
|
||||
# A form to create a new item
|
||||
if ($$args{"type"} eq "new") {
|
||||
$$args{"cols"} = [qw(no date title credits kw hid
|
||||
index arts)];
|
||||
# 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 no date title credits kw hid
|
||||
index arts
|
||||
created createdby updated updatedby)];
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"title"}) {
|
||||
# A form to create a new item
|
||||
if ($$args{"type"} eq "new") {
|
||||
$$args{"title"} = __("Add a New Newsletter");
|
||||
# A form to edit a current item
|
||||
} elsif ($$args{"type"} eq "cur") {
|
||||
$$args{"title"} = __("Edit a Current Newsletter");
|
||||
# A form to delete a current item
|
||||
} elsif ($$args{"type"} eq "del") {
|
||||
$$args{"title"} = __("Delete a Newsletter");
|
||||
}
|
||||
}
|
||||
if (!exists $$args{"preview"}) {
|
||||
$$args{"preview"} = 1;
|
||||
}
|
||||
if ($$args{"preview"} && !exists $$args{"prevmsg"}) {
|
||||
$$args{"prevmsg"} = __("Preview this newsletter.");
|
||||
}
|
||||
$self = $class->SUPER::new($status, $args);
|
||||
# The columns -- we need $self->{"form"} to calculate it
|
||||
@_ = grep /^ndx.+sub$/, sort $self->{"form"}->param;
|
||||
$_ = 3;
|
||||
$_ += 2 while (@_ = grep s/\d+sub$//, @_) > 0;
|
||||
# Take the larger value
|
||||
$self->{"colspan"} = $_ if $self->{"colspan"} < $_;
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _html_col_arts: The articles
|
||||
sub _html_col_arts : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $current, $label, $url, $mark, $colspan, $thclass, $thcolspan);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
$current = $self->{"cur"};
|
||||
$mark = $self->_mark("arts");
|
||||
$colspan = $self->_colspan;
|
||||
$label = h_abbr(__("[numerate,_1,Article,Articles]:", $current->param("artcount")));
|
||||
# A current form span for 2 columns
|
||||
$thclass = $self->{"type"} ne "cur"? " class=\"th\"": "";
|
||||
$thcolspan = $self->{"type"} eq "cur"? " colspan=\"2\"": "";
|
||||
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th$thclass$thcolspan scope="row">$mark$label</th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
@_ = qw();
|
||||
for ($_ = 0; $_ < $current->param("artcount"); $_++) {
|
||||
push @_, sprintf " <li><a href=\"%s\">%s</a></li>\n",
|
||||
h("nlarts.cgi?form=cur&sn=" . $current->param("art$_" . "sn")),
|
||||
$self->_cval_text("art$_" . "title");
|
||||
}
|
||||
print @_ > 0? "<ol>\n" . join("", @_) . " </ol>\n ": h_abbr(t_none);
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
|
||||
# _html_col_credits: The credits
|
||||
sub _html_col_credits : method {
|
||||
$_[0]->_html_coltmpl_textarea("credits", h_abbr(__("Credits:")),
|
||||
h(__("Fill in the credits here.")));
|
||||
}
|
||||
|
||||
# _html_col_hid: Hide?
|
||||
sub _html_col_hid : method {
|
||||
$_[0]->_html_coltmpl_bool("hid", h_abbr(__("Hide?")),
|
||||
h_abbr(__("Hide this newsletter")), h_abbr(__("Show this newsletter")),
|
||||
h_abbr(__("Hide this newsletter currently.")));
|
||||
}
|
||||
|
||||
# _html_col_index: The index
|
||||
sub _html_col_index : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $current, $label, $orig, $new, $mark, $colspan);
|
||||
my ($rowspan, $rows_new, $htmlsub);
|
||||
$self = $_[0];
|
||||
$form = $self->{"form"};
|
||||
$current = $self->{"cur"};
|
||||
$label = h_abbr(__("Index:"));
|
||||
$mark = $self->_mark("poems");
|
||||
$colspan = $self->_colspan;
|
||||
|
||||
# A form to create a new item
|
||||
if ($self->{"type"} eq "new") {
|
||||
($rowspan, $htmlsub) = $self->__html_col_index_form("ndx");
|
||||
$rowspan = $rowspan > 1? " rowspan=\"" . h($rowspan) . "\"": "";
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th class="th"$rowspan scope="row"><label for="ndx0">$mark$label</label></th>
|
||||
EOT
|
||||
print $htmlsub . "</tr>\n";
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($self->{"type"} eq "cur") {
|
||||
($rows_new, $htmlsub) = $self->__html_col_index_form("ndx");
|
||||
$rowspan = $rows_new + 1;
|
||||
$rows_new = $rows_new > 1? " rowspan=\"" . h($rows_new) . "\"": "";
|
||||
$rowspan = $rowspan > 1? " rowspan=\"" . h($rowspan) . "\"": "";
|
||||
$orig = h_abbr(__("Original:"));
|
||||
$new = h_abbr(__("New:"));
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th class="th"$rowspan scope="row"><label for="ndx0">$mark$label</label></th>
|
||||
<th class="oldnew" scope="row">$orig</th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
print $current->param("ndxcount") > 0?
|
||||
$self->__html_col_index_cur("ndx") . " ": h_abbr(t_none);
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<th class="oldnew"$rows_new scope="row">$new</th>
|
||||
EOT
|
||||
print $htmlsub . "</tr>\n";
|
||||
|
||||
# A form to delete a current item
|
||||
} else {
|
||||
$label = h_abbr(__("Index:"));
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th class="th" scope="row">$mark$label</th>
|
||||
EOT
|
||||
print " <td$colspan>";
|
||||
print $current->param("ndxcount") > 0?
|
||||
$self->__html_col_index_cur("ndx") . " ": h_abbr(t_none);
|
||||
print << "EOT";
|
||||
</td>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# _html_col_no: The issue number
|
||||
sub _html_col_no : method {
|
||||
local ($_, %_);
|
||||
my ($self, $label, $cur, $mark, $colspan, $thclass, $thcolspan);
|
||||
$self = $_[0];
|
||||
$label = h_abbr(__("Issue:"));
|
||||
$mark = $self->_mark("no");
|
||||
$colspan = $self->_colspan;
|
||||
|
||||
# A form to create a new item
|
||||
if ($self->{"type"} eq "new") {
|
||||
$cur = h_abbr(newslet_textno new_nl_no);
|
||||
print << "EOT"
|
||||
<tr>
|
||||
<th class="th" scope="row">$mark$label</th>
|
||||
<td$colspan>$cur</td>
|
||||
</tr>
|
||||
EOT
|
||||
|
||||
# A current or delete form
|
||||
} else {
|
||||
# A current form span for 2 columns
|
||||
$thclass = $self->{"type"} ne "cur"? " class=\"th\"": "";
|
||||
$thcolspan = $self->{"type"} eq "cur"? " colspan=\"2\"": "";
|
||||
$cur = h_abbr(newslet_textno scalar $self->{"cur"}->param("no"));
|
||||
print << "EOT";
|
||||
<tr>
|
||||
<th$thclass$thcolspan scope="row">$mark$label</th>
|
||||
<td$colspan>$cur</td>
|
||||
</tr>
|
||||
EOT
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# __html_col_index_cur: The current index
|
||||
sub __html_col_index_cur : method {
|
||||
local ($_, %_);
|
||||
my ($self, $colpref, $current, $html, $linepref, $title);
|
||||
($self, $colpref) = @_;
|
||||
$current = $self->{"cur"};
|
||||
($_, $linepref) = ($colpref, " ");
|
||||
$linepref .= " " while s/^\D+\d+//;
|
||||
|
||||
for ($_ = 0, @_ = qw(); $_ < $current->param($colpref . "count"); $_++) {
|
||||
$title = defined $current->param("$colpref$_" . "title")?
|
||||
$current->param("$colpref$_" . "title"):
|
||||
nlart_title($current->param("$colpref$_" . "art"));
|
||||
if (defined $current->param("$colpref$_" . "sub")) {
|
||||
push @_, sprintf("%1\$s<li>%2\$s\n%1\$s %3\$s%1\$s</li>\n", $linepref,
|
||||
h($title), $self->__html_col_index_cur("$colpref$_" . "sub"));
|
||||
} else {
|
||||
push @_, sprintf("%s<li>%s</li>\n", $linepref,
|
||||
h($title));
|
||||
}
|
||||
}
|
||||
return "<ol>\n" . join("", @_) . "$linepref</ol>\n";
|
||||
}
|
||||
|
||||
# __html_col_index_form: The index form
|
||||
sub __html_col_index_form : method {
|
||||
local ($_, %_);
|
||||
my ($self, $colpref, $form, $rows, $colspan, $title, $htmlform);
|
||||
my ($col, $val, $valartlabel, $textsub, $count, $choose, $delete);
|
||||
my ($labelart, $labeltitle, $labelsub, $labelsubs);
|
||||
my ($markart, $marktitle, $marksub, $marksubs);
|
||||
($self, $colpref) = @_;
|
||||
$form = $self->{"form"};
|
||||
($_, $colspan) = ($colpref, -2);
|
||||
$colspan -= 2 while s/^\D+\d+//;
|
||||
$colspan = $self->_colspan($colspan);
|
||||
$choose = h_abbr(__("Choose"));
|
||||
$delete = h_abbr(__("Delete"));
|
||||
$labelart = h_abbr(__("Article:"));
|
||||
$labeltitle = h_abbr(__("Title:"));
|
||||
$labelsub = h_abbr(__("Has subitems?"));
|
||||
$labelsubs = h_abbr(__("Subitems:"));
|
||||
$textsub = h(__("This item has subitems."));
|
||||
$markart = $self->_mark("ndxart");
|
||||
$marktitle = $self->_mark("ndxtitle");
|
||||
$marksub = $self->_mark("ndxhassub");
|
||||
$marksubs = $self->_mark("ndxsub");
|
||||
|
||||
# Find the last filled item
|
||||
for ($_ = 0; defined $form->param("$colpref$_" . "art")
|
||||
|| defined $form->param("$colpref$_" . "title"); $_++) {}
|
||||
for ($_--; $_ >= 0
|
||||
&& (!defined $form->param("$colpref$_" . "art")
|
||||
|| $form->param("$colpref$_" . "art") eq "")
|
||||
&& $form->param("$colpref$_" . "title") eq ""
|
||||
&& !defined $form->param("$colpref$_" . "sub"); $_--) {}
|
||||
$count = $_ + 1 + 2;
|
||||
for ($_ = 0, $rows = 0, @_ = qw(); $_ < $count; $_++) {
|
||||
my ($colart, $coltitle, $colsub, $colsub0, $valart, $valtitle, $valsub);
|
||||
$col = "$colpref$_";
|
||||
$val = $self->_val_check($col);
|
||||
# "" means not selected yet
|
||||
$form->delete($col . "art")
|
||||
if defined $form->param($col . "art") && $form->param($col . "art") eq "";
|
||||
$valart = $self->_val_text($col . "art");
|
||||
$colart = h($col . "art");
|
||||
$valartlabel = h(nlart_title $form->param($colart));
|
||||
$valtitle = $self->_val_text($col . "title");
|
||||
$coltitle = h_abbr($col . "title");
|
||||
$valsub = $self->_val_check($col . "sub");
|
||||
$colsub = h($col . "sub");
|
||||
$colsub0 = h($col . "sub0");
|
||||
$col = h($col);
|
||||
# An index item that has subitems
|
||||
if (defined $form->param("$colpref$_" . "sub")) {
|
||||
my ($htmlsub, $rows_form, $rows_sub);
|
||||
($rows_sub, $htmlsub) = $self->__html_col_index_form("$colpref$_" . "sub");
|
||||
$rows_form = $rows_sub + 3;
|
||||
$rows += $rows_form;
|
||||
$rows_form = $rows_form > 1? " rowspan=\"" . h($rows_form) . "\"": "";
|
||||
$rows_sub = $rows_sub > 1? " rowspan=\"" . h($rows_sub) . "\"": "";
|
||||
$htmlform = "";
|
||||
$htmlform .= << "EOT";
|
||||
<td$rows_form><input id="$col" type="checkbox" name="$col"$val /></td>
|
||||
<th class="th" scope="row"><label for="$colart">$markart$labelart</label></th>
|
||||
<td$colspan><input type="hidden" name="$colart"$valart />
|
||||
<label for="sel$colart">$valartlabel</label>
|
||||
EOT
|
||||
if (defined $form->param($col . "art")) {
|
||||
$htmlform .= << "EOT";
|
||||
<input id="del$colart" type="submit" name="del$colart" value="$delete" />
|
||||
EOT
|
||||
}
|
||||
$htmlform .= << "EOT";
|
||||
<input id="sel$colart" type="submit" name="sel$colart" value="$choose" />
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<th class="th" scope="row"><label for="$coltitle">$marktitle$labeltitle</label></th>
|
||||
<td$colspan><input id="$coltitle" class="text" type="text" name="$coltitle"$valtitle /></td>
|
||||
</tr>
|
||||
<tr>
|
||||
<th class="th" scope="row"><label for="$colsub">$marksub$labelsub</label></th>
|
||||
<td$colspan><input id="$colsub" type="checkbox" name="$colsub"$valsub />
|
||||
<label for="$colsub">$textsub</label></td>
|
||||
</tr>
|
||||
<tr>
|
||||
<th class="th"$rows_sub scope="row"><label for="$colsub0">$marksubs$labelsubs</label></th>
|
||||
EOT
|
||||
$htmlform .= $htmlsub;
|
||||
|
||||
# An end index item
|
||||
} else {
|
||||
$rows += 3;
|
||||
$htmlform = "";
|
||||
$htmlform .= << "EOT";
|
||||
<td rowspan="3"><input id="$col" type="checkbox" name="$col"$val /></td>
|
||||
<th class="th" scope="row"><label for="$colart">$markart$labelart</label></th>
|
||||
<td$colspan><input type="hidden" name="$colart"$valart />
|
||||
<label for="sel$colart">$valartlabel</label>
|
||||
EOT
|
||||
if (defined $form->param($col . "art")) {
|
||||
$htmlform .= << "EOT";
|
||||
<input id="del$colart" type="submit" name="del$colart" value="$delete" />
|
||||
EOT
|
||||
}
|
||||
$htmlform .= << "EOT";
|
||||
<input id="sel$colart" type="submit" name="sel$colart" value="$choose" />
|
||||
</td>
|
||||
</tr>
|
||||
<tr>
|
||||
<th class="th" scope="row"><label for="$coltitle">$marktitle$labeltitle</label></th>
|
||||
<td$colspan><input id="$coltitle" class="text" type="text" name="$coltitle"$valtitle /></td>
|
||||
</tr>
|
||||
<tr>
|
||||
<th class="th" scope="row"><label for="$colsub">$marksub$labelsub</label></th>
|
||||
<td$colspan><input id="$colsub" type="checkbox" name="$colsub"$valsub />
|
||||
<label for="$colsub">$textsub</label></td>
|
||||
EOT
|
||||
}
|
||||
push @_, $htmlform;
|
||||
}
|
||||
return ($rows, join("</tr>\n<tr>\n", @_));
|
||||
}
|
||||
|
||||
return 1;
|
||||
684
htdocs/htc/magicat/lib/perl5/Selima/htc/HTML.pm
Normal file
684
htdocs/htc/magicat/lib/perl5/Selima/htc/HTML.pm
Normal file
@@ -0,0 +1,684 @@
|
||||
# History: Theory and Culture
|
||||
# HTML.pm: The HTML web page parts.
|
||||
|
||||
# Copyright (c) 2003-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2003-04-06
|
||||
|
||||
package Selima::htc::HTML;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Exporter);
|
||||
use vars qw(@EXPORT @EXPORT_OK);
|
||||
BEGIN {
|
||||
@EXPORT = qw();
|
||||
push @EXPORT, qw(html_header html_title html_message);
|
||||
push @EXPORT, qw(html_errmsg html_body html_links html_links_index html_footer);
|
||||
@EXPORT_OK = @EXPORT;
|
||||
# Prototype declaration
|
||||
sub html_header($;$);
|
||||
sub html_title($;$);
|
||||
sub html_message($);
|
||||
sub html_errmsg($);
|
||||
sub html_nav(;$);
|
||||
sub html_login(;$);
|
||||
sub html_nav_admin(;$);
|
||||
sub html_nav_page(;$);
|
||||
sub html_body($;$);
|
||||
sub html_links($;$);
|
||||
sub html_links_index(\@;$);
|
||||
sub html_footer(;$);
|
||||
sub merged_tree($$;$);
|
||||
}
|
||||
|
||||
use Cwd qw(realpath);
|
||||
use File::Basename qw(dirname);
|
||||
use File::Spec::Functions qw();
|
||||
use IO::NestedCapture qw(CAPTURE_STDOUT);
|
||||
|
||||
use Selima::A2HTML;
|
||||
use Selima::AddGet;
|
||||
use Selima::AltLang;
|
||||
use Selima::DataVars qw(:author :env :input :list :lninfo :requri :siteconf);
|
||||
use Selima::ErrMsg;
|
||||
use Selima::HTTPS;
|
||||
use Selima::Links;
|
||||
use Selima::LnInfo;
|
||||
use Selima::LogIn;
|
||||
use Selima::MarkAbbr;
|
||||
use Selima::MungAddr;
|
||||
use Selima::PageFunc;
|
||||
use Selima::Preview;
|
||||
use Selima::ScptPriv;
|
||||
use Selima::ShortCut;
|
||||
use Selima::Unicode;
|
||||
use Selima::XFileIO;
|
||||
|
||||
use vars qw(@ADMIN_SCRIPTS %HEADER %FOOTER);
|
||||
@ADMIN_SCRIPTS = (
|
||||
{ "title" => N_("Manage Content"),
|
||||
"sub" => [
|
||||
{ "title" => N_("Guestbook"),
|
||||
"path" => "/magicat/cgi-bin/guestbook.cgi" },
|
||||
{ "title" => N_("Pages"),
|
||||
"path" => "/magicat/cgi-bin/pages.cgi" },
|
||||
{ "title" => N_("Links"),
|
||||
"path" => "/magicat/cgi-bin/links.cgi" },
|
||||
{ "title" => N_("Link Categories"),
|
||||
"path" => "/magicat/cgi-bin/linkcat.cgi" },
|
||||
{ "title" => N_("Link Categorization"),
|
||||
"path" => "/magicat/cgi-bin/linkcatz.cgi" },
|
||||
{ "title" => N_("Newsletters"),
|
||||
"path" => "/magicat/cgi-bin/newslets.cgi" },
|
||||
{ "title" => N_("Newsletter Indices"),
|
||||
"path" => "/magicat/cgi-bin/nlindex.cgi" },
|
||||
{ "title" => N_("Newsletter Articles"),
|
||||
"path" => "/magicat/cgi-bin/nlarts.cgi" },
|
||||
],
|
||||
},
|
||||
{ "title" => N_("Manage Accounts"),
|
||||
"sub" => [
|
||||
{ "title" => N_("Users"),
|
||||
"path" => "/magicat/cgi-bin/users.cgi" },
|
||||
{ "title" => N_("Groups"),
|
||||
"path" => "/magicat/cgi-bin/groups.cgi" },
|
||||
{ "title" => N_("User Membership"),
|
||||
"path" => "/magicat/cgi-bin/usermem.cgi" },
|
||||
{ "title" => N_("Group Membership"),
|
||||
"path" => "/magicat/cgi-bin/groupmem.cgi" },
|
||||
{ "title" => N_("User Preferences"),
|
||||
"path" => "/magicat/cgi-bin/userpref.cgi" },
|
||||
{ "title" => N_("Script Privileges"),
|
||||
"path" => "/magicat/cgi-bin/scptpriv.cgi" },
|
||||
],
|
||||
},
|
||||
{ "title" => N_("Miscellaneous"),
|
||||
"sub" => [
|
||||
{ "title" => N_("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:htc\@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 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_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;
|
||||
174
htdocs/htc/magicat/lib/perl5/Selima/htc/Items.pm
Normal file
174
htdocs/htc/magicat/lib/perl5/Selima/htc/Items.pm
Normal file
@@ -0,0 +1,174 @@
|
||||
# History: Theory and Culture
|
||||
# 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-04-28
|
||||
|
||||
package Selima::htc::Items;
|
||||
use 5.008;
|
||||
use utf8;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Exporter);
|
||||
use vars qw(@EXPORT @EXPORT_OK);
|
||||
BEGIN {
|
||||
@EXPORT = qw();
|
||||
push @EXPORT, qw(new_nl_no newslet_textno newslet_title newslet_no);
|
||||
push @EXPORT, qw(nlindex_title nlart_title);
|
||||
@EXPORT_OK = @EXPORT;
|
||||
# Prototype declaration
|
||||
sub new_nl_no();
|
||||
sub newslet_textno($);
|
||||
sub newslet_title($);
|
||||
sub newslet_no($);
|
||||
sub nlindex_title($);
|
||||
sub nlart_title($);
|
||||
}
|
||||
|
||||
use Encode qw(encode);
|
||||
use Lingua::ZH::Numbers;
|
||||
|
||||
use Selima::ChkFunc;
|
||||
use Selima::CommText;
|
||||
use Selima::DataVars qw($DBH);
|
||||
|
||||
# new_nl_no: Get the issue number for a new newsletter
|
||||
sub new_nl_no() {
|
||||
local ($_, %_);
|
||||
my ($sql, $sth);
|
||||
$sql = "SELECT no FROM newslets"
|
||||
. " ORDER BY no DESC LIMIT 1;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
return 1 if $sth->rows < 1;
|
||||
return ${$sth->fetch}[0] + 1;
|
||||
}
|
||||
|
||||
# newslet_textno: Obtain the text representation of the issue number
|
||||
sub newslet_textno($) {
|
||||
local ($_, %_);
|
||||
$_ = $_[0];
|
||||
# Invalid - returned "as is"
|
||||
return $_ if !defined $_ || /\D/ || $_ < 0;
|
||||
# First issue
|
||||
return "創刊號" if $_ == 1;
|
||||
Lingua::ZH::Numbers->charset("traditional");
|
||||
return "第" . number_to_zh($_) . "期";
|
||||
}
|
||||
|
||||
# newslet_title: Obtain a newsletter title
|
||||
sub newslet_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 no, title FROM newslets"
|
||||
. " WHERE sn=$sn;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
|
||||
# Not found
|
||||
return t_na unless $sth->rows == 1;
|
||||
|
||||
# Found
|
||||
$row = $sth->fetchrow_hashref;
|
||||
$_ = newslet_textno $$row{"no"};
|
||||
$_ .= "：「" . $$row{"title"} . "」專號" if defined $$row{"title"};
|
||||
return $_;
|
||||
}
|
||||
|
||||
# newslet_no: Obtain a newsletter number
|
||||
sub newslet_no($) {
|
||||
local ($_, %_);
|
||||
my ($sn, $sql, $sth);
|
||||
$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 no FROM newslets"
|
||||
. " WHERE sn=$sn;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
|
||||
# Not found
|
||||
return t_na unless $sth->rows == 1;
|
||||
|
||||
# Found
|
||||
return ${$sth->fetch}[0];
|
||||
}
|
||||
|
||||
# nlindex_title: Obtain a newsletter index item title
|
||||
sub nlindex_title($) {
|
||||
local ($_, %_);
|
||||
my ($sn, $sql, $sth);
|
||||
$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 nlindex_fulltitle(parent, COALESCE(nlindex.title, nlarts.title)) AS title FROM nlindex"
|
||||
. " LEFT JOIN nlarts ON nlindex.art=nlarts.sn"
|
||||
. " WHERE nlindex.sn=$sn;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
|
||||
# Not found
|
||||
return t_na unless $sth->rows == 1;
|
||||
|
||||
# Found
|
||||
return ${$sth->fetch}[0];
|
||||
}
|
||||
|
||||
# nlart_title: Obtain a newsletter article title
|
||||
sub nlart_title($) {
|
||||
local ($_, %_);
|
||||
my ($sn, $sql, $sth);
|
||||
$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 nlarts"
|
||||
. " WHERE sn=$sn;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
|
||||
# Not found
|
||||
return t_na unless $sth->rows == 1;
|
||||
|
||||
# Found
|
||||
return ${$sth->fetch}[0];
|
||||
}
|
||||
|
||||
no utf8;
|
||||
return 1;
|
||||
38
htdocs/htc/magicat/lib/perl5/Selima/htc/L10N.pm
Normal file
38
htdocs/htc/magicat/lib/perl5/Selima/htc/L10N.pm
Normal file
@@ -0,0 +1,38 @@
|
||||
# History: Theory and Culture
|
||||
# L10N.pm: The localization class.
|
||||
|
||||
# Copyright (c) 2003-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2003-04-26
|
||||
|
||||
package Selima::htc::L10N;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Locale::Maketext::Gettext);
|
||||
|
||||
return 1;
|
||||
|
||||
# The Chinese (Taiwan) localized messages.
|
||||
package Selima::htc::L10N::zh_tw;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Locale::Maketext::Gettext);
|
||||
|
||||
sub numerate : method { $_[2] }
|
||||
|
||||
return 1;
|
||||
47
htdocs/htc/magicat/lib/perl5/Selima/htc/List/Guestbook.pm
Normal file
47
htdocs/htc/magicat/lib/perl5/Selima/htc/List/Guestbook.pm
Normal file
@@ -0,0 +1,47 @@
|
||||
# History: Theory and Culture
|
||||
# Guestbook.pm: The administrative guestbook message list.
|
||||
|
||||
# Copyright (c) 2004-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2004-10-24
|
||||
|
||||
package Selima::htc::List::Guestbook;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List::Guestbook);
|
||||
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "guestbook" if !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = $self->{"is_called_form"}?
|
||||
__("Select a Message"):
|
||||
__("Manage the Guestbook");
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"identity" => __("Occupation"),
|
||||
);
|
||||
return $self;
|
||||
}
|
||||
|
||||
return 1;
|
||||
@@ -0,0 +1,36 @@
|
||||
# History: Theory and Culture
|
||||
# Public.pm: The guestbook message list.
|
||||
|
||||
# Copyright (c) 2004-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2004-10-24
|
||||
|
||||
package Selima::htc::List::Guestbook::Public;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List::Guestbook::Public);
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($class, $self);
|
||||
($class, @_) = @_;
|
||||
$self = $class->SUPER::new(@_);
|
||||
return $self;
|
||||
}
|
||||
|
||||
return 1;
|
||||
98
htdocs/htc/magicat/lib/perl5/Selima/htc/List/NLArts.pm
Normal file
98
htdocs/htc/magicat/lib/perl5/Selima/htc/List/NLArts.pm
Normal file
@@ -0,0 +1,98 @@
|
||||
# History: Theory and Culture
|
||||
# NLArts.pm: The newsletter 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-04-28
|
||||
|
||||
package Selima::htc::List::NLArts;
|
||||
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] = "nlarts" if !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = $self->{"is_called_form"}?
|
||||
__("Select a Newsletter Article"):
|
||||
__("Manage Newsletter Articles");
|
||||
# Columns that should display its brief instead
|
||||
push @{$self->{"COLS_BRIEF"}}, qw(body annots);
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"newslet" => __("Newsletter"),
|
||||
"title_h" => __("HTML title"),
|
||||
"author" => __("Author"),
|
||||
"authors" => __("Authors column"),
|
||||
"annots" => __("Annotations"),
|
||||
);
|
||||
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 article."));
|
||||
}
|
||||
|
||||
# html_search: Display the search box
|
||||
sub html_search : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_search(__("Search for an article:"));
|
||||
}
|
||||
|
||||
# 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);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
93
htdocs/htc/magicat/lib/perl5/Selima/htc/List/NLIndex.pm
Normal file
93
htdocs/htc/magicat/lib/perl5/Selima/htc/List/NLIndex.pm
Normal file
@@ -0,0 +1,93 @@
|
||||
# History: Theory and Culture
|
||||
# NLIndex.pm: The newsletter index list.
|
||||
|
||||
# Copyright (c) 2006-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-04-28
|
||||
|
||||
package Selima::htc::List::NLIndex;
|
||||
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] = "nlindex" if !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = $self->{"is_called_form"}?
|
||||
__("Select a Newsletter Index Item"):
|
||||
__("Manage Newsletter Index");
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"newslet" => __("Newsletter"),
|
||||
"art" => __("Article"),
|
||||
);
|
||||
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 index item."));
|
||||
}
|
||||
|
||||
# html_search: Display the search box
|
||||
sub html_search : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_search(__("Search for an index item:"));
|
||||
}
|
||||
|
||||
# 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,index item].", $self->{"total"});
|
||||
# List result
|
||||
} else {
|
||||
return __("[*,_1,index item].", $self->{"total"});
|
||||
}
|
||||
# More than one page
|
||||
} else {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return __("Your query found [*,_1,index item], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
# List result
|
||||
} else {
|
||||
return __("[*,_1,index item], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
97
htdocs/htc/magicat/lib/perl5/Selima/htc/List/Newslets.pm
Normal file
97
htdocs/htc/magicat/lib/perl5/Selima/htc/List/Newslets.pm
Normal file
@@ -0,0 +1,97 @@
|
||||
# History: Theory and Culture
|
||||
# Newslets.pm: The newsletter list.
|
||||
|
||||
# Copyright (c) 2006-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-04-28
|
||||
|
||||
package Selima::htc::List::Newslets;
|
||||
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] = "newslets" if !defined $_[1];
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
$self->{"title"} = $self->{"is_called_form"}?
|
||||
__("Select a Newsletter"):
|
||||
__("Manage Newsletters");
|
||||
# The default sort order
|
||||
$self->{"DEFAULT_SORTBY"} = "-no";
|
||||
# Columns that should display its brief instead
|
||||
push @{$self->{"COLS_BRIEF"}}, qw(credits);
|
||||
# Column labels
|
||||
$self->col_labels(
|
||||
"no" => __("Issue"),
|
||||
"credits" => __("Credits"),
|
||||
);
|
||||
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 newsletter."));
|
||||
}
|
||||
|
||||
# html_search: Display the search box
|
||||
sub html_search : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_search(__("Search for a newsletter:"));
|
||||
}
|
||||
|
||||
# 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,newsletter].", $self->{"total"});
|
||||
# List result
|
||||
} else {
|
||||
return __("[*,_1,newsletter].", $self->{"total"});
|
||||
}
|
||||
# More than one page
|
||||
} else {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return __("Your query found [*,_1,newsletter], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
# List result
|
||||
} else {
|
||||
return __("[*,_1,newsletter], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return 1;
|
||||
181
htdocs/htc/magicat/lib/perl5/Selima/htc/List/Search.pm
Normal file
181
htdocs/htc/magicat/lib/perl5/Selima/htc/List/Search.pm
Normal file
@@ -0,0 +1,181 @@
|
||||
# History: Theory and Culture
|
||||
# Search.pm: The web site full-text search result list.
|
||||
|
||||
# Copyright (c) 2006-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-04-28
|
||||
|
||||
package Selima::htc::List::Search;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::List);
|
||||
|
||||
use Selima::Logging;
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the handler
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$self = $class->SUPER::new(@_);
|
||||
# The page title
|
||||
if (!defined $self->{"query"}) {
|
||||
$self->{"title"} = __("Full Text Search");
|
||||
} else {
|
||||
$self->{"title"} = __("Search Result");
|
||||
}
|
||||
$self->{"view"} = "search_list";
|
||||
$self->{"COLS_NO_SEARCH"} = [qw(section path date html)];
|
||||
return $self;
|
||||
}
|
||||
|
||||
# fetch: Fetch the current list
|
||||
sub fetch : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# No search specified
|
||||
if (!defined $self->{"query"}) {
|
||||
$self->{"total"} = undef;
|
||||
return $self->{"error"};
|
||||
}
|
||||
# Check the query phrase
|
||||
# Regularize it
|
||||
$self->{"query"} =~ s/^\s*(.*?)\s*$/$1/;
|
||||
# Check if it is filled
|
||||
if ($self->{"query"} eq"") {
|
||||
$self->{"total"} = undef;
|
||||
$self->{"error"} = {"msg"=>N_("Please fill in your query.")};
|
||||
return $self->{"error"};
|
||||
}
|
||||
# Run the parent method
|
||||
$self->SUPER::fetch;
|
||||
# Add an activity log record
|
||||
actlog("Query with phrase \"" . $self->{"query"} . "\".");
|
||||
# Done
|
||||
return $self->{"error"};
|
||||
}
|
||||
|
||||
# sql_orderby: Get the SQL ORDER BY phase
|
||||
# Always return nothing
|
||||
sub sql_orderby : method { return ""; }
|
||||
|
||||
# html_newlink: Display a link to add a new item
|
||||
# Make it a null function
|
||||
sub html_newlink : method {}
|
||||
|
||||
# html_search: Display the search box
|
||||
sub html_search : method {
|
||||
# Run the parent method
|
||||
return $_[0]->SUPER::html_search(__("Search in the website:"));
|
||||
}
|
||||
|
||||
# liststat_message: Return the current list statistics message
|
||||
sub liststat_message : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
|
||||
# No record to list
|
||||
if ($self->{"total"} == 0) {
|
||||
# Inherit the empty list statistics message
|
||||
return $self->SUPER::liststat_message;
|
||||
# Fit in one page
|
||||
} elsif ($self->{"total"} <= $self->{"pagesize"}) {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return __("Your query found [*,_1,article].", $self->{"total"});
|
||||
# List result
|
||||
} else {
|
||||
return __("[*,_1,article].", $self->{"total"});
|
||||
}
|
||||
# More than one page
|
||||
} else {
|
||||
# Result comes from a query
|
||||
if (defined $self->{"query"}) {
|
||||
return __("Your query found [*,_1,article], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
# List result
|
||||
} else {
|
||||
return __("[*,_1,article], listing [#,_2] to [#,_3].",
|
||||
$self->{"total"}, $self->{"startno"}+1, $self->{"endno"}+1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# html_list: List the items
|
||||
sub html_list : method {
|
||||
local ($_, %_);
|
||||
my ($self);
|
||||
$self = $_[0];
|
||||
# Do not show the list
|
||||
return if !defined $self->{"total"};
|
||||
# No record to be listed
|
||||
return if $self->{"total"} == 0;
|
||||
|
||||
print << "EOT";
|
||||
<ol class="searchresult">
|
||||
EOT
|
||||
|
||||
# Print each record
|
||||
foreach my $current (@{$self->{"current"}}) {
|
||||
my ($url, $abstract);
|
||||
$url = h($$current{"path"});
|
||||
$abstract = $self->query_abstract($current);
|
||||
if ($$current{"section"} eq "pages") {
|
||||
my $title;
|
||||
$title = h($$current{"title"});
|
||||
|
||||
print << "EOT";
|
||||
<li><h3><a href="$url">$title</a></h3>
|
||||
EOT
|
||||
} elsif ($$current{"section"} eq "links") {
|
||||
my ($title, $sectitle);
|
||||
$title = h($$current{"title"});
|
||||
$sectitle = h(__("Related Links"));
|
||||
|
||||
print << "EOT";
|
||||
<li><h3><a href="$url">$title</a></h3>
|
||||
<address><a href="/links/">$sectitle</a></address>
|
||||
EOT
|
||||
} elsif ($$current{"section"} eq "guestbook") {
|
||||
my ($author, $title, $sectitle);
|
||||
$author = defined $$current{"author"}?
|
||||
" <span class=\"note\">" . h($$current{"author"}) . "</span>": "";
|
||||
$title = h(__("Guestbook Message on [_1]", $$current{"date"}));
|
||||
$sectitle = h(__("Guestbook"));
|
||||
|
||||
print << "EOT";
|
||||
<li><h3><a href="$url">$title</a>$author</h3>
|
||||
<address><a href="/cgi-bin/guestbook.cgi">$sectitle</a></address>
|
||||
EOT
|
||||
}
|
||||
print "\n<p>$abstract</p>\n" if defined $abstract;
|
||||
print << "EOT";
|
||||
</li>
|
||||
|
||||
EOT
|
||||
}
|
||||
print << "EOT";
|
||||
</ol>
|
||||
|
||||
EOT
|
||||
return;
|
||||
}
|
||||
|
||||
return 1;
|
||||
@@ -0,0 +1,141 @@
|
||||
# History: Theory and Culture
|
||||
# Public.pm: The guestbook data processor.
|
||||
|
||||
# Copyright (c) 2006-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2006-03-19
|
||||
|
||||
package Selima::htc::Processor::Guestbook::Public;
|
||||
use 5.008;
|
||||
use utf8;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Processor::Guestbook);
|
||||
|
||||
use Selima::Country;
|
||||
use Selima::DataVars qw(:env :input :scptconf);
|
||||
use Selima::Format;
|
||||
use Selima::Guest;
|
||||
use Selima::GeoIP;
|
||||
use Selima::RemoHost;
|
||||
use Selima::Unicode;
|
||||
|
||||
# new: Initialize the processor
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[0]->param("form", "new");
|
||||
$_[0]->param("confirm", 1);
|
||||
$self = $class->SUPER::new(@_);
|
||||
$self->{"notify"} = 1;
|
||||
$self->{"debug"} = 1;
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _save_cols: Save the column deposit
|
||||
sub _save_cols : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
($self, @_) = @_;
|
||||
$self->SUPER::_save_cols(@_);
|
||||
$self->{"cols"}->{"login"} = 723676436;
|
||||
return;
|
||||
}
|
||||
|
||||
# _other_tasks: Perform tasks other than column updates
|
||||
sub _other_tasks : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form);
|
||||
my ($mail, $body, $charset);
|
||||
$self = $_[0];
|
||||
return unless $self->{"notify"};
|
||||
$form = $self->{"form"};
|
||||
|
||||
# Compose the mail body
|
||||
$body = "";
|
||||
$body .= "若要編輯或刪除這則留言，請連上以下網址：\n";
|
||||
$body .= "http://" . $ENV{"SERVER_NAME"} . "/magicat/cgi-bin/guestbook.cgi"
|
||||
. "?form=cur&sn=" . $self->{"sn"} . "\n\n";
|
||||
$body .= "日期： " . fmttime . "\n";
|
||||
@_ = qw();
|
||||
push @_, ctname_zhtw country_lookup;
|
||||
push @_, remote_host if defined remote_host;
|
||||
$body .= "來自： " . $ENV{"REMOTE_ADDR"}
|
||||
. " (" . join(", ", @_) . ")\n";
|
||||
$body .= "簽名： " . $form->param("name") . "\n"
|
||||
if $form->param("name") ne "";
|
||||
$body .= "職業： " . $form->param("identity") . "\n"
|
||||
if $form->param("identity") ne "";
|
||||
$body .= "所在地： " . $form->param("location") . "\n"
|
||||
if $form->param("location") ne "";
|
||||
$body .= "E-mail ： " . $form->param("email") . "\n"
|
||||
if $form->param("email") ne "";
|
||||
$body .= "網站網址： " . $form->param("url") . "\n"
|
||||
if $form->param("url") ne "" && $form->param("url") ne "http://";
|
||||
$body .= "留言：\n\n" . $form->param("message") . "\n\n";
|
||||
$body .= "原始內容：\n" . $USER_INPUT{"POST_RAWDATA"} . "\n";
|
||||
|
||||
# Collecting Debugging infomation
|
||||
if ($self->{"debug"}) {
|
||||
$body .= "\n";
|
||||
$body .= "===== Start Debugging Infomation =====\n";
|
||||
if ($IS_MODPERL) {
|
||||
$_ = $IS_MP2? Apache2::RequestUtil->request->as_string:
|
||||
Apache->request->as_string;
|
||||
s/^X-Selima-[^\n]+\n//mg;
|
||||
s/^((?:[^\n]+\n)+).+?$/$1/s;
|
||||
$body .= $_;
|
||||
} else {
|
||||
foreach (sort grep !/^HTTP_X_SELIMA_/, grep /^HTTP_/, keys %ENV) {
|
||||
my $hname;
|
||||
$hname = $_;
|
||||
$hname =~ s/^HTTP_//;
|
||||
$hname =~ s/_/-/g;
|
||||
$hname =~ s/(\w)(\w+)/$1 . lc $2/ge;
|
||||
$body .= "$hname: $ENV{$_}\n";
|
||||
}
|
||||
}
|
||||
$body .= "===== End Debugging Infomation =====\n";
|
||||
}
|
||||
|
||||
# Set the best appropriate output character set
|
||||
$charset = is_charset($body, "Big5")? "Big5": "UTF-8";
|
||||
|
||||
# Compose the mail
|
||||
$mail = new Selima::Mail;
|
||||
$mail->charset($charset);
|
||||
$mail->from($THIS_FILE . "\@" . $ENV{"SERVER_NAME"}, "歷史：理論與文化網站留言板");
|
||||
$mail->to("htc\@mail.emandy.idv.tw", "歷史：理論與文化編輯");
|
||||
$mail->subject("[HTC] 留言板留言通知 " . fmtdate);
|
||||
$mail->body($body);
|
||||
# Send it
|
||||
$mail->send;
|
||||
return;
|
||||
}
|
||||
|
||||
# _actlog: Log the activity
|
||||
sub _actlog : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# A form to create a new item
|
||||
return gactlog "Post a new message on " . fmtdate($self->{"date"})
|
||||
. " with s/n " . $self->{"sn"} . ".";
|
||||
}
|
||||
|
||||
no utf8;
|
||||
return 1;
|
||||
132
htdocs/htc/magicat/lib/perl5/Selima/htc/Processor/NLArt.pm
Normal file
132
htdocs/htc/magicat/lib/perl5/Selima/htc/Processor/NLArt.pm
Normal file
@@ -0,0 +1,132 @@
|
||||
# History: Theory and Culture
|
||||
# NLArt.pm: The newsletter article 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-04-30
|
||||
|
||||
package Selima::htc::Processor::NLArt;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Processor);
|
||||
|
||||
use Selima::DataVars qw(:addcol);
|
||||
use Selima::Guest;
|
||||
use Selima::ShortCut;
|
||||
|
||||
use Selima::htc::Items;
|
||||
use Selima::htc::Rebuild;
|
||||
|
||||
# new: Initialize the processor
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "nlarts" 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("newslet", $self->_form("newslet"));
|
||||
$self->{"cols"}->addnum("ord", $self->_form("ord"));
|
||||
$self->{"cols"}->addstr("title", $self->_form("title"));
|
||||
$self->{"cols"}->addstr("title_h", $self->_form("title_h"));
|
||||
$self->{"cols"}->addstr("author", $self->_form("author"));
|
||||
$self->{"cols"}->addstr("email", $self->_form("email"));
|
||||
$self->{"cols"}->addstr("authors", $self->_form("authors"));
|
||||
$self->{"cols"}->addstr("body", $self->_form("body"));
|
||||
$self->{"cols"}->addstr("annots", $self->_form("annots"));
|
||||
$self->{"cols"}->addstr("kw", $self->_form("kw"));
|
||||
$self->{"cols"}->addbool("html", $self->_form("html"));
|
||||
$self->{"cols"}->addbool("hid", $self->_form("hid"));
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($self->{"type"} eq "cur") {
|
||||
$self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
|
||||
$self->{"cols"}->addnum("newslet", $self->_form("newslet"), scalar $cur->param("newslet"));
|
||||
$self->{"cols"}->addnum("ord", $self->_form("ord"), scalar $cur->param("ord"));
|
||||
$self->{"cols"}->addstr("title", $self->_form("title"), scalar $cur->param("title"));
|
||||
$self->{"cols"}->addstr("title_h", $self->_form("title_h"), scalar $cur->param("title_h"));
|
||||
$self->{"cols"}->addstr("author", $self->_form("author"), scalar $cur->param("author"));
|
||||
$self->{"cols"}->addstr("email", $self->_form("email"), scalar $cur->param("email"));
|
||||
$self->{"cols"}->addstr("authors", $self->_form("authors"), scalar $cur->param("authors"));
|
||||
$self->{"cols"}->addstr("body", $self->_form("body"), scalar $cur->param("body"));
|
||||
$self->{"cols"}->addstr("annots", $self->_form("annots"), scalar $cur->param("annots"));
|
||||
$self->{"cols"}->addstr("kw", $self->_form("kw"), scalar $cur->param("kw"));
|
||||
$self->{"cols"}->addbool("html", $self->_form("html"), scalar $cur->param("html"));
|
||||
$self->{"cols"}->addbool("hid", $self->_form("hid"), scalar $cur->param("hid"));
|
||||
}
|
||||
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 newsletter article " . $form->param("title")
|
||||
. " in newsletter No. " . newslet_no($form->param("newslet"))
|
||||
. " with s/n " . $self->{"sn"} . "."
|
||||
if $self->{"type"} eq "new";
|
||||
# A form to edit a current item
|
||||
return gactlog "Update the newsletter article " . $form->param("title")
|
||||
. " in newsletter No. " . newslet_no($form->param("newslet"))
|
||||
. " with s/n " . $self->{"sn"} . "."
|
||||
if $self->{"type"} eq "cur";
|
||||
# A form to delete a current item
|
||||
return gactlog "Delete the newsletter article " . $cur->param("title")
|
||||
. " in newsletter No. " . newslet_no($cur->param("newslet"))
|
||||
. " 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 article was not modified."),
|
||||
"isform"=>0}
|
||||
if !$self->_modified;
|
||||
# A form to create a new item
|
||||
return {"msg"=>N_("This article has been successfully added."),
|
||||
"isform"=>0}
|
||||
if $self->{"type"} eq "new";
|
||||
# A form to edit a current item
|
||||
return {"msg"=>N_("This article has been successfully updated."),
|
||||
"isform"=>0}
|
||||
if $self->{"type"} eq "cur";
|
||||
# A form to delete a current item
|
||||
return {"msg"=>N_("This article has been successfully deleted."),
|
||||
"isform"=>0}
|
||||
if $self->{"type"} eq "del";
|
||||
}
|
||||
|
||||
return 1;
|
||||
122
htdocs/htc/magicat/lib/perl5/Selima/htc/Processor/NLIndex.pm
Normal file
122
htdocs/htc/magicat/lib/perl5/Selima/htc/Processor/NLIndex.pm
Normal file
@@ -0,0 +1,122 @@
|
||||
# History: Theory and Culture
|
||||
# NLIndex.pm: The newsletter index 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-04-29
|
||||
|
||||
package Selima::htc::Processor::NLIndex;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Processor);
|
||||
|
||||
use Selima::DataVars qw(:addcol);
|
||||
use Selima::Guest;
|
||||
use Selima::ShortCut;
|
||||
|
||||
use Selima::htc::Items;
|
||||
|
||||
# new: Initialize the processor
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "nlindex" if @_ < 2;
|
||||
$self = $class->SUPER::new(@_);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _save_cols: Save the column deposit
|
||||
sub _save_cols : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $cur, $o);
|
||||
$self = $_[0];
|
||||
($form, $cur) = ($self->{"form"}, $self->{"cur"});
|
||||
if ($self->{"type"} ne "del") {
|
||||
# Set the "topmost" parent
|
||||
$form->delete("parent") if defined $form->param("topmost")
|
||||
&& $form->param("topmost") eq "true";
|
||||
}
|
||||
# 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("newslet", $self->_form("newslet"));
|
||||
$self->{"cols"}->addnum("parent", $self->_form("parent"));
|
||||
$self->{"cols"}->addnum("ord", $self->_form("ord"));
|
||||
$self->{"cols"}->addnum("art", $self->_form("art"));
|
||||
$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("newslet", $self->_form("newslet"), scalar $cur->param("newslet"));
|
||||
$self->{"cols"}->addnum("parent", $self->_form("parent"), scalar $cur->param("parent"));
|
||||
$self->{"cols"}->addnum("ord", $self->_form("ord"), scalar $cur->param("ord"));
|
||||
$self->{"cols"}->addnum("art", $self->_form("art"), scalar $cur->param("art"));
|
||||
$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 newsletter index item " . $form->param("title")
|
||||
. " for newsletter No. " . newslet_no($form->param("newslet"))
|
||||
. " with s/n " . $self->{"sn"} . "."
|
||||
if $self->{"type"} eq "new";
|
||||
# A form to edit a current item
|
||||
return gactlog "Update the newsletter index item " . $form->param("title")
|
||||
. " for newsletter No. " . newslet_no($form->param("newslet"))
|
||||
. " with s/n " . $self->{"sn"} . "."
|
||||
if $self->{"type"} eq "cur";
|
||||
# A form to delete a current item
|
||||
return gactlog "Delete the newsletter index item " . $cur->param("title")
|
||||
. " for newsletter No. " . newslet_no($cur->param("newslet"))
|
||||
. " 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 index item was not modified."),
|
||||
"isform"=>0}
|
||||
if !$self->_modified;
|
||||
# A form to create a new item
|
||||
return {"msg"=>N_("This index item has been successfully added."),
|
||||
"isform"=>0}
|
||||
if $self->{"type"} eq "new";
|
||||
# A form to edit a current item
|
||||
return {"msg"=>N_("This index item has been successfully updated."),
|
||||
"isform"=>0}
|
||||
if $self->{"type"} eq "cur";
|
||||
# A form to delete a current item
|
||||
return {"msg"=>N_("This index item has been successfully deleted."),
|
||||
"isform"=>0}
|
||||
if $self->{"type"} eq "del";
|
||||
}
|
||||
|
||||
return 1;
|
||||
121
htdocs/htc/magicat/lib/perl5/Selima/htc/Processor/Newslet.pm
Normal file
121
htdocs/htc/magicat/lib/perl5/Selima/htc/Processor/Newslet.pm
Normal file
@@ -0,0 +1,121 @@
|
||||
# History: Theory and Culture
|
||||
# Newslet.pm: The newsletter 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-04-29
|
||||
|
||||
package Selima::htc::Processor::Newslet;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
use base qw(Selima::Processor);
|
||||
|
||||
use Selima::DataVars qw(:addcol);
|
||||
use Selima::Guest;
|
||||
use Selima::ShortCut;
|
||||
|
||||
# new: Initialize the processor
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($self, $class);
|
||||
($class, @_) = @_;
|
||||
$_[1] = "newslets" if @_ < 2;
|
||||
$self = $class->SUPER::new(@_);
|
||||
return $self;
|
||||
}
|
||||
|
||||
# _save_cols: Save the column deposit
|
||||
sub _save_cols : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $cur, $o);
|
||||
$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("no", $self->_form("no"));
|
||||
$self->{"cols"}->adddate("date", $self->_form("date"));
|
||||
$self->{"cols"}->addstr("title", $self->_form("title"));
|
||||
$self->{"cols"}->addstr("credits", $self->_form("credits"));
|
||||
$self->{"cols"}->addstr("kw", $self->_form("kw"));
|
||||
$self->{"cols"}->addbool("hid", $self->_form("hid"));
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($self->{"type"} eq "cur") {
|
||||
$self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
|
||||
$self->{"cols"}->addnum("no", $self->_form("no"), scalar $cur->param("no"));
|
||||
$self->{"cols"}->adddate("date", $self->_form("date"), scalar $cur->param("date"));
|
||||
$self->{"cols"}->addstr("title", $self->_form("title"), scalar $cur->param("title"));
|
||||
$self->{"cols"}->addstr("credits", $self->_form("credits"), scalar $cur->param("credits"));
|
||||
$self->{"cols"}->addstr("kw", $self->_form("kw"), scalar $cur->param("kw"));
|
||||
$self->{"cols"}->addbool("hid", $self->_form("hid"), scalar $cur->param("hid"));
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($self->{"type"} eq "del") {
|
||||
# Find the changed items
|
||||
$_ = new CGI("");
|
||||
$_->param("cond", "newslet=" . $self->{"sn"});
|
||||
push @{$self->{"subs"}}, new Selima::Processor::Deletion($_, "nlarts");
|
||||
}
|
||||
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 newsletter No. " . $form->param("no")
|
||||
. " with s/n " . $self->{"sn"} . "."
|
||||
if $self->{"type"} eq "new";
|
||||
# A form to edit a current item
|
||||
return gactlog "Update the newsletter No. " . $form->param("no")
|
||||
. " with s/n " . $self->{"sn"} . "."
|
||||
if $self->{"type"} eq "cur";
|
||||
# A form to delete a current item
|
||||
return gactlog "Delete the newsletter No. " . $cur->param("no")
|
||||
. " 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 newsletter was not modified."),
|
||||
"isform"=>0}
|
||||
if !$self->_modified;
|
||||
# A form to create a new item
|
||||
return {"msg"=>N_("This newsletter has been successfully added."),
|
||||
"isform"=>0}
|
||||
if $self->{"type"} eq "new";
|
||||
# A form to edit a current item
|
||||
return {"msg"=>N_("This newsletter has been successfully updated."),
|
||||
"isform"=>0}
|
||||
if $self->{"type"} eq "cur";
|
||||
# A form to delete a current item
|
||||
return {"msg"=>N_("This newsletter has been successfully deleted."),
|
||||
"isform"=>0}
|
||||
if $self->{"type"} eq "del";
|
||||
}
|
||||
|
||||
return 1;
|
||||
290
htdocs/htc/magicat/lib/perl5/Selima/htc/Rebuild.pm
Normal file
290
htdocs/htc/magicat/lib/perl5/Selima/htc/Rebuild.pm
Normal file
@@ -0,0 +1,290 @@
|
||||
# History: Theory and Culture
|
||||
# Rebuild.pm: The subroutines to rebuild the web pages.
|
||||
|
||||
# Copyright (c) 2004-2018 imacat.
|
||||
#
|
||||
# Licensed under the Apache License, Version 2.0 (the "License");
|
||||
# you may not use this file except in compliance with the License.
|
||||
# You may obtain a copy of the License at
|
||||
#
|
||||
# http://www.apache.org/licenses/LICENSE-2.0
|
||||
#
|
||||
# Unless required by applicable law or agreed to in writing, software
|
||||
# distributed under the License is distributed on an "AS IS" BASIS,
|
||||
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
||||
# See the License for the specific language governing permissions and
|
||||
# limitations under the License.
|
||||
|
||||
# Author: imacat <imacat@mail.imacat.idv.tw>
|
||||
# First written: 2004-11-02
|
||||
|
||||
package Selima::htc::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_newslets compose_page);
|
||||
@EXPORT_OK = @EXPORT;
|
||||
# Prototype declaration
|
||||
sub rebuild_all();
|
||||
sub rebuild_pages(;$);
|
||||
sub rebuild_links(;$);
|
||||
sub rebuild_newslets(@);
|
||||
sub compose_page($;$);
|
||||
}
|
||||
|
||||
use Data::Dumper qw();
|
||||
use Fcntl qw(:flock);
|
||||
use IO::NestedCapture qw(CAPTURE_STDOUT);
|
||||
|
||||
use Selima::DataVars qw($DBH :output :rebuild);
|
||||
use Selima::GetLang;
|
||||
use Selima::Guest;
|
||||
use Selima::PageFunc;
|
||||
use Selima::ShortCut;
|
||||
|
||||
use Selima::htc::HTML;
|
||||
|
||||
use vars qw($PKGL10N);
|
||||
|
||||
# rebuild_all: Rebuild everything
|
||||
sub rebuild_all() {
|
||||
local ($_, %_);
|
||||
# Lock the required tables
|
||||
$DBH->lock(map { $_ => LOCK_SH } @REBUILD_TABLES);
|
||||
# Rebuild the pages
|
||||
rebuild_pages;
|
||||
# Rebuild the links
|
||||
rebuild_links;
|
||||
# Rebuild the index
|
||||
# To be done
|
||||
#rebuild_index;
|
||||
return;
|
||||
}
|
||||
|
||||
# rebuild_pages: Rebuild the pages
|
||||
sub rebuild_pages(;$) {
|
||||
local ($_, %_);
|
||||
my ($sql, $sth, $count, $rebuild_everything);
|
||||
my $lang;
|
||||
$sql = $_[0];
|
||||
|
||||
$lang = getlang;
|
||||
|
||||
# Rebuild everything
|
||||
$rebuild_everything = !defined $sql;
|
||||
if ($rebuild_everything) {
|
||||
$sql = "SELECT * FROM pages"
|
||||
. " WHERE NOT hid;\n";
|
||||
}
|
||||
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$count = $sth->rows;
|
||||
# Bounce if no pages to build on a partial rebuild
|
||||
# This prevents needless sitemap rebuilding
|
||||
return if !$rebuild_everything && $count == 0;
|
||||
# Build each page
|
||||
for (my $i = 0; $i < $count; $i++) {
|
||||
my ($page, $html);
|
||||
$page = $sth->fetchrow_hashref;
|
||||
# Read the picture into the picture deposit
|
||||
# To be done
|
||||
|
||||
$html = compose_page($page, $lang);
|
||||
goutpage $html, $$page{"path"}, $lang
|
||||
if defined $html;
|
||||
|
||||
# Output related pictures only when rebuilding everything
|
||||
# To be done
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
# rebuild_links: Rebuild the links
|
||||
sub rebuild_links(;$) {
|
||||
local ($_, %_);
|
||||
my ($sql, $sth, $count, $FD, $rebuild_everything);
|
||||
my ($lang, $args, $html);
|
||||
$sql = $_[0];
|
||||
|
||||
$lang = getlang;
|
||||
|
||||
# Rebuild everything
|
||||
$rebuild_everything = !defined $sql;
|
||||
if ($rebuild_everything) {
|
||||
@_ = $DBH->cols("linkcat");
|
||||
push @_, $DBH->strcat("'/links'", "linkcat_path(sn, id, parent)")
|
||||
. " AS path";
|
||||
$sql = "SELECT " . join(", ", @_) . " FROM linkcat"
|
||||
. " WHERE linkcat_isshown(sn, hid, parent);\n";
|
||||
}
|
||||
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$count = $sth->rows;
|
||||
for (my $i = 0; $i < $count; $i++) {
|
||||
my ($page, $sql1, $sth1, $count1, $row1);
|
||||
$page = $sth->fetchrow_hashref;
|
||||
|
||||
# Find the ancesters
|
||||
@_ = $DBH->cols("linkcat");
|
||||
push @_, $DBH->strcat("'/links'", "linkcat_path(sn, id, parent)")
|
||||
. " AS path";
|
||||
$sql1 = "SELECT " . join(", ", @_) . " FROM linkcat"
|
||||
. " WHERE linkcat_ischild(sn, " . $$page{"sn"} . ")"
|
||||
. " ORDER BY linkcat_fullord(parent, ord);\n";
|
||||
$sth1 = $DBH->prepare($sql1);
|
||||
$sth1->execute;
|
||||
$count1 = $sth1->rows;
|
||||
for (my $i = 0, $$page{"parents"} = []; $i < $count1; $i++) {
|
||||
push @{$$page{"parents"}}, $sth1->fetchrow_hashref;
|
||||
}
|
||||
|
||||
# Find the subcategories
|
||||
@_ = $DBH->cols("linkcat");
|
||||
push @_, $DBH->strcat("'/links'", "linkcat_path(sn, id, parent)")
|
||||
. " AS path";
|
||||
$sql1 = "SELECT " . join(", ", @_) . " FROM linkcat"
|
||||
. " WHERE parent=" . $$page{"sn"}
|
||||
. " AND linkcat_isshown(sn, hid, parent)"
|
||||
. " ORDER BY ord;\n";
|
||||
$sth1 = $DBH->prepare($sql1);
|
||||
$sth1->execute;
|
||||
$count1 = $sth1->rows;
|
||||
for (my $i = 0, $$page{"scats"} = []; $i < $count1; $i++) {
|
||||
my ($sql2, $sth2, $row2);
|
||||
$row1 = $sth1->fetchrow_hashref;
|
||||
# Find the belonging links
|
||||
$sql2 = "SELECT count(linkcatz.sn) AS count FROM linkcatz"
|
||||
. " INNER JOIN links ON linkcatz.link=links.sn"
|
||||
. " INNER JOIN linkcat ON linkcatz.cat=linkcat.sn"
|
||||
. " WHERE linkcatz.cat=" . $$row1{"sn"}
|
||||
. " AND NOT links.hid;\n";
|
||||
$sth2 = $DBH->prepare($sql2);
|
||||
$sth2->execute;
|
||||
$row2 = $sth2->fetchrow_hashref;
|
||||
$$row1{"links"} = $$row2{"count"};
|
||||
push @{$$page{"scats"}}, $row1;
|
||||
}
|
||||
|
||||
# Find the belonging links
|
||||
@_ = map "links.$_", $DBH->cols("links");
|
||||
$sql1 = "SELECT " . join(", ", @_) . " FROM links"
|
||||
. " INNER JOIN linkcatz ON linkcatz.link=links.sn"
|
||||
. " WHERE linkcatz.cat=" . $$page{"sn"}
|
||||
. " AND NOT links.hid;\n";
|
||||
$sth1 = $DBH->prepare($sql1);
|
||||
$sth1->execute;
|
||||
$count1 = $sth1->rows;
|
||||
for (my $i = 0, $$page{"links"} = []; $i < $count1; $i++) {
|
||||
push @{$$page{"links"}}, $sth1->fetchrow_hashref;
|
||||
}
|
||||
|
||||
$html = compose_page($page, $lang);
|
||||
goutpage $html, $$page{"path"}, $lang
|
||||
if defined $html;
|
||||
}
|
||||
|
||||
# Build the root index page
|
||||
@_ = $DBH->cols("linkcat");
|
||||
push @_, $DBH->strcat("'/links'", "linkcat_path(sn, id, parent)")
|
||||
. " AS path";
|
||||
$sql = "SELECT " . join(", ", @_) . " FROM linkcat"
|
||||
. " WHERE parent IS NULL"
|
||||
. " AND linkcat_isshown(sn, hid, parent)"
|
||||
. " ORDER BY ord;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
$count = $sth->rows;
|
||||
for ($_ = 0, @_ = qw(); $_ < $count; $_++) {
|
||||
my ($cat, $sql1, $sth1, $count1);
|
||||
$cat = $sth->fetchrow_hashref;
|
||||
|
||||
# Find the belonging links
|
||||
$sql1 = "SELECT count(linkcatz.sn) AS count FROM linkcatz"
|
||||
. " INNER JOIN links ON linkcatz.link=links.sn"
|
||||
. " INNER JOIN linkcat ON linkcatz.cat=linkcat.sn"
|
||||
. " WHERE linkcatz.cat=" . $$cat{"sn"}
|
||||
. " AND NOT links.hid;\n";
|
||||
$sth1 = $DBH->prepare($sql1);
|
||||
$sth1->execute;
|
||||
$$cat{"links"} = ${$sth1->fetch}[0];
|
||||
|
||||
push @_, $cat;
|
||||
}
|
||||
$ALT_PAGE_PARAM = {
|
||||
"path" => "/links/",
|
||||
"lang" => $lang,
|
||||
"keywords" => __("related links"),
|
||||
"class" => "links",
|
||||
"static" => 1,
|
||||
"all_linguas" => [$lang]};
|
||||
$args = page_param;
|
||||
# Obtain the page
|
||||
IO::NestedCapture->start(CAPTURE_STDOUT);
|
||||
binmode IO::NestedCapture->instance->{"STDOUT_current"}[-1], ":utf8";
|
||||
html_header __("Related Links"), $args;
|
||||
html_links_index @_, $args;
|
||||
html_footer $args;
|
||||
IO::NestedCapture->stop(CAPTURE_STDOUT);
|
||||
$FD = IO::NestedCapture->get_last_out;
|
||||
$html = join "", <$FD>;
|
||||
undef $ALT_PAGE_PARAM;
|
||||
goutpage $html, "/links/", $lang;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
# rebuild_newslets: Rebuild the newsletters
|
||||
sub rebuild_newslets(@) {
|
||||
local ($_, %_);
|
||||
return;
|
||||
}
|
||||
|
||||
# compose_page: Compose a page
|
||||
sub compose_page($;$) {
|
||||
local ($_, %_);
|
||||
my ($page, $lang, $args, $FD);
|
||||
($page, $lang) = @_;
|
||||
$lang = getlang if !defined $lang;
|
||||
|
||||
$ALT_PAGE_PARAM = {
|
||||
"path" => $$page{"path"},
|
||||
"lang" => $lang,
|
||||
"keywords" => $$page{"kw"},
|
||||
"static" => 1,
|
||||
"all_linguas" => [$lang]};
|
||||
$$ALT_PAGE_PARAM{"preview"} = $page
|
||||
if exists $$page{"preview"};
|
||||
if (exists $$page{"class"} && defined $$page{"class"} && $$page{"class"} ne "") {
|
||||
$$ALT_PAGE_PARAM{"class"} = $$page{"class"};
|
||||
} elsif ($$page{"path"} =~ /^\/links\//) {
|
||||
$$ALT_PAGE_PARAM{"class"} = "links";
|
||||
}
|
||||
$args = page_param;
|
||||
|
||||
# Obtain the page
|
||||
IO::NestedCapture->start(CAPTURE_STDOUT);
|
||||
binmode IO::NestedCapture->instance->{"STDOUT_current"}[-1], ":utf8";
|
||||
html_header $$page{"title"}, $args;
|
||||
if ($$page{"path"} =~ /^\/links\/$/) {
|
||||
#html_links_index $page, $args;
|
||||
} elsif ($$page{"path"} =~ /^\/links\/.+$/) {
|
||||
html_links $page, $args;
|
||||
} else {
|
||||
html_body $page, $args;
|
||||
}
|
||||
html_footer $args;
|
||||
IO::NestedCapture->stop(CAPTURE_STDOUT);
|
||||
$FD = IO::NestedCapture->get_last_out;
|
||||
$_ = join "", <$FD>;
|
||||
|
||||
undef $ALT_PAGE_PARAM;
|
||||
return $_;
|
||||
}
|
||||
|
||||
return 1;
|
||||
Reference in New Issue
Block a user