imacat/selima-perl
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial commit.

Browse Source
This commit is contained in:
依瑪貓
2026-03-10 21:25:26 +08:00
commit 78739bf725
3089 changed files with 472990 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

70
htdocs/wov/magicat/lib/perl5/Selima/wov.pm Normal file
View File

@@ -0,0 +1,70 @@
# Woman's Voice
# wov.pm: Woman's Voice
# 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::wov;
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::wov::Config;
push @EXPORT, @Selima::wov::Config::EXPORT;
use Selima::wov::DataVars qw(:all);
push @EXPORT, @Selima::wov::DataVars::EXPORT_OK;
use Selima::wov::HTML;
push @EXPORT, @Selima::wov::HTML::EXPORT;
use Selima::wov::Items;
push @EXPORT, @Selima::wov::Items::EXPORT;
use Selima::wov::Rebuild;
push @EXPORT, @Selima::wov::Rebuild::EXPORT;
# Import our site-specific classess
use Selima::wov::Checker::Guestbook;
use Selima::wov::Checker::Guestbook::Public;
use Selima::wov::Checker::Newslet;
use Selima::wov::Checker::NLArt;
use Selima::wov::Form::Guestbook;
use Selima::wov::Form::Guestbook::Public;
use Selima::wov::Form::Page;
use Selima::wov::Form::LinkCat;
use Selima::wov::Form::Newslet;
use Selima::wov::Form::NLArt;
use Selima::wov::L10N;
use Selima::wov::List::Guestbook;
use Selima::wov::List::Guestbook::Public;
use Selima::wov::List::Newslets;
use Selima::wov::List::NLArts;
use Selima::wov::List::Search;
use Selima::wov::Processor::Guestbook::Public;
use Selima::wov::Processor::Page;
use Selima::wov::Processor::LinkCat;
use Selima::wov::Processor::Newslet;
use Selima::wov::Processor::NLArt;
# Import our common modules
use Selima;
push @EXPORT, @Selima::EXPORT;
@EXPORT_OK = @EXPORT;
return 1;

27
htdocs/wov/magicat/lib/perl5/Selima/wov/Checker/Guestbook.pm Normal file
View File

@@ -0,0 +1,27 @@
# Woman's Voice
# 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::wov::Checker::Guestbook;
use 5.008;
use strict;
use warnings;
use base qw(Selima::Checker::Guestbook);
return 1;

60
htdocs/wov/magicat/lib/perl5/Selima/wov/Checker/Guestbook/Public.pm Normal file
View File

@@ -0,0 +1,60 @@
# Woman's Voice
# 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::wov::Checker::Guestbook::Public;
use 5.008;
use utf8;
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;
# _checkspam_local: Check the local content filter
sub _checkspam_local : method {
local ($_, %_);
my ($self, $form);
$self = $_[0];
$form = $self->{"form"};
# Block HiNet 61.224.20x till 2007-05-01, for 粉領上班族
$self->_block_spam("_checkspam_local(): Suspicious spamming from 粉領上班族")
if time <= 1177948800
&& $ENV{"REMOTE_ADDR"} =~ /^61\.224\.20\d/;
# OK
return;
}
# Old blocker
# 清濤命理網站 http://click.twmis.net/
# $self->_block_spam("_checkspam_local(): Suspicious spamming from http://click.twmis.net/.")
# if $form->param("message") =~ /http:\/\/click\.twmis\.net/i
# || $form->param("url") =~ /http:\/\/click\.twmis\.net/i
# || $form->param("message") =~ /http:\/\/unn\.sexll\.com/i
# || $form->param("url") =~ /http:\/\/unn\.sexll\.com/i
# || $form->param("message") =~ /靈異節目(?:....)?老師/;
# Icegirl
# $self->_block_spam("_checkspam_local(): Suspicious spamming from Icegirl.")
# if $ENV{"REMOTE_ADDR"} eq "218.166.124.90" || $ENV{"REMOTE_ADDR"} eq "218.166.125.76";
no utf8;
return 1;

139
htdocs/wov/magicat/lib/perl5/Selima/wov/Checker/NLArt.pm Normal file
View File

@@ -0,0 +1,139 @@
# Woman's Voice
# NLArt.pm: The newsletter article 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-11-24
package Selima::wov::Checker::NLArt;
use 5.008;
use strict;
use warnings;
use base qw(Selima::Checker);
use Selima::CallForm;
use Selima::ChkFunc;
use Selima::ShortCut;
use Selima::wov::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_author: Check the author
# Use the default author checker
# _check_body_h: Check the HTML content body
sub _check_body_h : method {
local ($_, %_);
my ($self, $form, $error);
$self = $_[0];
$form = $self->{"form"};
# Check if it exists
$error = $self->_missing("body_h");
return $error if defined $error;
# Regularize it
$self->_trimtext("body_h");
# Check if it is filled
$form->param("body_h", "")
if $form->param("body_h") eq __("Fill in the HTML content here.");
return {"msg"=>N_("Please fill in the HTML content.")}
if $form->param("body_h") eq "";
# Check the length
return {"msg"=>N_("This HTML content is too long. (Max. length [#,_1])"),
"margs"=>[${$self->{"maxlens"}}{"body_h"}]}
if length $form->param("body_h") > ${$self->{"maxlens"}}{"body_h"};
# OK
return;
}
# _check_body_t: Check the plain text content body
sub _check_body_t : method {
local ($_, %_);
my ($self, $form, $error);
$self = $_[0];
$form = $self->{"form"};
# Check if it exists
$error = $self->_missing("body_t");
return $error if defined $error;
# Regularize it
$self->_trimtext("body_t");
# Check if it is filled
$form->param("body_t", "")
if $form->param("body_t") eq __("Fill in the plain text content here.");
return {"msg"=>N_("Please fill in the plain text content.")}
if $form->param("body_t") eq "";
# Check the length
return {"msg"=>N_("This plain text content is too long. (Max. length [#,_1])"),
"margs"=>[${$self->{"maxlens"}}{"body_t"}]}
if length $form->param("body_t") > ${$self->{"maxlens"}}{"body_t"};
# 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
# _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;

173
htdocs/wov/magicat/lib/perl5/Selima/wov/Checker/Newslet.pm Normal file
View File

@@ -0,0 +1,173 @@
# Woman's Voice
# Newslet.pm: The newsletter 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-11-22
package Selima::wov::Checker::Newslet;
use 5.008;
use strict;
use warnings;
use base qw(Selima::Checker);
use CGI qw();
use Selima::ChkFunc;
use Selima::DataVars qw(:dataman);
use Selima::ShortCut;
use Selima::wov::Items;
use Selima::wov::Checker::NLArt;
# 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_arts: Check the articles
sub _check_arts : method {
local ($_, %_);
my ($self, $form);
$self = $_[0];
$form = $self->{"form"};
# Remove the default content
foreach (grep /^art\d+body_t$/, $form->param) {
$form->param($_, "")
if $form->param($_) eq __("Fill in the plain text content here.");
}
foreach (grep /^art\d+body_h$/, $form->param) {
$form->param($_, "")
if $form->param($_) eq __("Fill in the HTML content here.");
}
# Loop each article
for ($_ = 0; !$self->_missing("art$_" . "title"); $_++) {
my ($subform, $checker, $error);
# Skip unselected ones
next if $self->_missing("art$_");
# Regularize it
$self->_trim("art$_" . "title");
$self->_trim("art$_" . "author");
$self->_trimtext("art$_" . "body_t");
$self->_trimtext("art$_" . "body_h");
# Check with the subform checker
$subform = new CGI("");
$subform->param("newslet", $self->{"sn"}) if $self->{"iscur"};
$subform->param("title", $form->param("art$_" . "title"));
$subform->param("author", $form->param("art$_" . "author"));
$subform->param("body_t", $form->param("art$_" . "body_t"));
$subform->param("body_h", $form->param("art$_" . "body_h"));
$checker = new Selima::wov::Checker::NLArt($subform);
$error = $checker->check("title", "author", "body_t", "body_h");
return $error if defined $error;
}
return;
}
# _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_cred_t: Check the plain text credits
sub _check_cred_t : method {
local ($_, %_);
my ($self, $form, $error);
$self = $_[0];
$form = $self->{"form"};
# Check if it exists
$error = $self->_missing("cred_t");
return $error if defined $error;
# Regularize it
$self->_trimtext("cred_t");
# Check if it is filled
return {"msg"=>N_("Please fill in the plain text credits information.")}
if $form->param("cred_t") eq "";
# Check the length
return {"msg"=>N_("This plain text credits information is too long. (Max. length [#,_1])"),
"margs"=>[${$self->{"maxlens"}}{"cred_t"}]}
if length $form->param("cred_t") > ${$self->{"maxlens"}}{"cred_t"};
# OK
return;
}
# _check_cred_h: Check the HTML credits
sub _check_cred_h : method {
local ($_, %_);
my ($self, $form, $error);
$self = $_[0];
$form = $self->{"form"};
# Check if it exists
$error = $self->_missing("cred_h");
return $error if defined $error;
# Regularize it
$self->_trimtext("cred_h");
# Check if it is filled
return {"msg"=>N_("Please fill in the HTML credits information.")}
if $form->param("cred_h") eq "";
# Check the length
return {"msg"=>N_("This HTML credits information is too long. (Max. length [#,_1])"),
"margs"=>[${$self->{"maxlens"}}{"cred_h"}]}
if length $form->param("cred_h") > ${$self->{"maxlens"}}{"cred_h"};
# OK
return;
}
return 1;

93
htdocs/wov/magicat/lib/perl5/Selima/wov/Config.pm Normal file
View File

@@ -0,0 +1,93 @@
# Woman's Voice
# 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::wov::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::wov::DataVars qw(:all);
# siteconf: Subroutine to initialize site configuration
sub siteconf() {
local ($_, %_);
# The package name and the package title
$PACKAGE = "wov";
$SITENAME_ABBR = "WOV";
# The author and the copyright
$AUTHOR = "小招, 依瑪貓";
$COPYRIGHT = "&copy; <!--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 local rebuild type labels
%REBUILD_LABELS = (
"newslets" => N_("Newsletter"),
);
# 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_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" => "1999(?:-\\d{4})?",
"content" => copyyear(1999),
},
"generator" => {
"pattern" => "Selima \\d+\\.\\d+",
"content" => "Selima $Selima::VERSION",
},
};
}
no utf8;
return 1;

58
htdocs/wov/magicat/lib/perl5/Selima/wov/DataVars.pm Normal file
View File

@@ -0,0 +1,58 @@
# Woman's Voice
# DataVars.pm: The site-wide constants and variables.
# 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-25
package Selima::wov::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_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_NLARTS => 1002;
# clear: Clear the data variables
sub clear() {
local ($_, %_);
delete $SCRIPTS{FORM_NEWSLETS()};
delete $SCRIPTS{FORM_NLARTS()};
return;
}
return 1;

40
htdocs/wov/magicat/lib/perl5/Selima/wov/Form/Guestbook.pm Normal file
View File

@@ -0,0 +1,40 @@
# Woman's Voice
# 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::wov::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(__("What kind of women you are?")));
}
# _html_col_url: The website URL
sub _html_col_url : method {
$_[0]->_html_coltmpl_url("url", h_abbr(__("Website URL.:")));
}
return 1;

66
htdocs/wov/magicat/lib/perl5/Selima/wov/Form/Guestbook/Public.pm Normal file
View File

@@ -0,0 +1,66 @@
# Woman's Voice
# 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::wov::Form::Guestbook::Public;
use 5.008;
use utf8;
use strict;
use warnings;
use base qw(Selima::Form::Guestbook::Public);
use Selima::HTTP;
use Selima::MarkAbbr;
use Selima::ShortCut;
# new: Initialize the HTML form table displayer
sub new : method {
local ($_, %_);
my ($class, $status, $args, $self);
($class, $status, $args) = @_;
$args = {} if !defined $args;
# $args must be a hash reference
http_500 "type of argument 2 must be a hash reference"
if ref($args) ne "HASH";
$$args{"prefmsg"} = [] if !exists $$args{"prefmsg"};
push @{$$args{"prefmsg"}}, __("General commercial advertisements, articles unrelated to gender/sex or articles involving personal attacks are not welcomed. They may be deleted without notice. HTML is not supported.");
$self = $class->SUPER::new($status, $args);
return $self;
}
# _html_col_identity: The identity
sub _html_col_identity : method {
$_[0]->_html_coltmpl_text("identity", h_abbr(__("What kind of women you are?")),
h_abbr("（女工、女學生、粉領上班族、公私娼酒吧舞女、打工辣妹……）"));
}
# _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_url: The website URL
sub _html_col_url : method {
$_[0]->_html_coltmpl_url("url", h_abbr(__("Website URL.:")));
}
no utf8;
return 1;

58
htdocs/wov/magicat/lib/perl5/Selima/wov/Form/LinkCat.pm Normal file
View File

@@ -0,0 +1,58 @@
# Woman's Voice
# LinkCat.pm: The related-link category 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-05
package Selima::wov::Form::LinkCat;
use 5.008;
use strict;
use warnings;
use base qw(Selima::Form::LinkCat);
use Selima::FormFunc;
use Selima::HTTP;
# 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"};
if (!exists $$args{"cols"}) {
# A form to create a new item
if ($$args{"type"} eq "new") {
$$args{"cols"} = [qw(parent id ord title title_en kw 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 parent id ord title title_en kw hid
scats links
created createdby updated updatedby)];
}
}
$self = $class->SUPER::new($status, $args);
return $self;
}
return 1;

130
htdocs/wov/magicat/lib/perl5/Selima/wov/Form/NLArt.pm Normal file
View File

@@ -0,0 +1,130 @@
# Woman's Voice
# NLArt.pm: The newsletter article 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-11-24
package Selima::wov::Form::NLArt;
use 5.008;
use strict;
use warnings;
use base qw(Selima::Form);
use Selima::ChkFunc;
use Selima::CommText;
use Selima::FormFunc;
use Selima::HTTP;
use Selima::MarkAbbr;
use Selima::ShortCut;
use Selima::Unicode;
use Selima::wov::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 write 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 author body_t body_h 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 author body_t body_h hid
created createdby updated updatedby)];
}
}
if (!exists $$args{"title"}) {
# A form to create a new item
if ($$args{"type"} eq "new") {
$$args{"title"} = __("Write a New 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");
}
}
$self = $class->SUPER::new($status, $args);
${$self->{"maxlens"}}{"ord"} = 2;
return $self;
}
# _html_col_body_t: The plain text body
sub _html_col_body_t : method {
$_[0]->_html_coltmpl_textarea("body_t", h_abbr(__("Content (text):")),
h(__("Fill in the plain text content here.")));
}
# _html_col_body_h: The HTML body
sub _html_col_body_h : method {
$_[0]->_html_coltmpl_textarea("body_h", h_abbr(__("Content (HTML):")),
h(__("Fill in the HTML content here.")));
}
# _html_col_hid: Hide?
sub _html_col_hid : method {
$_[0]->_html_coltmpl_bool("hid", h_abbr(__("Hide?")),
h_abbr(__("Hide this article")), h_abbr(__("Show this article")),
h_abbr(__("Hide this article currently.")));
}
# _html_col_newslet: The newsletter
sub _html_col_newslet : method {
$_[0]->_html_coltmpl_call("newslet", h_abbr(__("Newsletter:")), \&newslet_title);
}
# _html_col_ord: The order
sub _html_col_ord : method {
local ($_, %_);
my ($self, $form);
$self = $_[0];
$form = $self->{"form"};
# Set the default order to the half of the maximum
$form->param("ord", 99)
if $self->{"is_first_form"} && $self->{"type"} eq "new";
$self->_html_coltmpl_text("ord", h_abbr(__("Order:")), undef,
${$self->{"maxlens"}}{"ord"});
}
return 1;

408
htdocs/wov/magicat/lib/perl5/Selima/wov/Form/Newslet.pm Normal file
View File

@@ -0,0 +1,408 @@
# Woman's Voice
# Newslet.pm: The newsletter 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-11-17
package Selima::wov::Form::Newslet;
use 5.008;
use strict;
use warnings;
use base qw(Selima::Form);
use Selima::A2HTML;
use Selima::ChkFunc;
use Selima::CommText;
use Selima::FormFunc;
use Selima::HTTP;
use Selima::MarkAbbr;
use Selima::ShortCut;
use Selima::wov::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.");
}
}
$$args{"colspan"} = 3
if !exists $$args{"colspan"};
if (!exists $$args{"cols"}) {
# A form to create a new item
if ($$args{"type"} eq "new") {
$$args{"cols"} = [qw(no date title cred_t cred_h kw arts 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 no date title cred_t cred_h kw arts 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");
# 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);
return $self;
}
# _html_col_arts: The articles
sub _html_col_arts : method {
local ($_, %_);
my ($self, $form, $current, $label, $orig, $new, $mark, $colspan, $cols, $rows);
my ($col, $val, $no, $rowspan, $rows_cur, $rows_new, $count_new);
my ($labeltitle, $labelauthor, $labelbody_t, $labelbody_h, $labelhid);
my ($marktitle, $markauthor, $markbody_t, $markbody_h, $markhid);
my ($hbody_tdef, $hbody_hdef, $texthid, $true, $false);
$self = $_[0];
$form = $self->{"form"};
$current = $self->{"cur"};
$mark = $self->_mark("arts");
$colspan = $self->_colspan(-2);
$cols = h($self->{"defsize"});
$rows = h(10);
$labeltitle = h_abbr(__("Title:"));
$labelauthor = h_abbr(__("Author:"));
$labelbody_t = h_abbr(__("Content (text):"));
$labelbody_h = h_abbr(__("Content (HTML):"));
$labelhid = h_abbr(__("Hide?"));
$hbody_tdef = h(__("Fill in the plain text content here."));
$hbody_hdef = h(__("Fill in the HTML content here."));
$texthid = h(__("Hide this article currently."));
$marktitle = $self->_mark("arttitle");
$markauthor = $self->_mark("artauthor");
$markbody_t = $self->_mark("artbody_t");
$markbody_h = $self->_mark("artbody_h");
$markhid = $self->_mark("arthid");
$true = h(__("Hide this article"));
$false = h(__("Show this article"));
# A form to create a new item
if ($self->{"type"} eq "new") {
# Find the last filled article
for ($_ = 0; defined $form->param("art$_" . "title"); $_++) {}
for ($_--; $_ >= 0
&& $form->param("art$_" . "title") eq ""
&& $form->param("art$_" . "author") eq ""
&& $form->param("art$_" . "body_t") eq ""
&& $form->param("art$_" . "body_h") eq ""; $_--) {}
$count_new = $_ + 1 + 3;
$rows_new = $count_new * 5;
$rows_new = $rows_new > 1? " rowspan=\"" . h($rows_new) . "\"": "";
$label = h_abbr(__("[numerate,_1,Article]:", 0));
print << "EOT";
<tr>
<th class="th"$rows_new scope="row"><label for="art0title">$mark$label</label></th>
EOT
for ($_ = 0, @_ = qw(); $_ < $count_new; $_++) {
my ($coltitle, $colauthor, $colbody_t, $colbody_h, $colhid);
my ($valtitle, $valauthor, $valbody_t, $valbody_h, $valhid);
$col = "art$_";
$val = $self->_val_check($col);
$valtitle = $self->_val_text($col . "title");
$coltitle = h($col . "title");
$valauthor = $self->_val_text($col . "author");
$colauthor = h($col . "author");
$valbody_t = $self->_val_textarea($col . "body_t", $hbody_tdef);
$colbody_t = h($col . "body_t");
$valbody_h = $self->_val_textarea($col . "body_h", $hbody_hdef);
$colbody_h = h($col . "body_h");
$valhid = $self->_val_check($col . "hid");
$colhid = h($col . "hid");
$col = h($col);
push @_, << "EOT";
<td rowspan="5"><input id="$col" type="checkbox" name="$col"$val /></td>
<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="$colauthor">$markauthor$labelauthor</label></th>
<td$colspan><input id="$colauthor" class="text" type="text" name="$colauthor"$valauthor /></td>
</tr>
<tr>
<th class="th" scope="row"><label for="$colbody_t">$markbody_t$labelbody_t</label></th>
<td$colspan><textarea id="$colbody_t" name="$colbody_t" cols="$cols" rows="$rows"
onfocus="if (this.value == &quot;$hbody_tdef&quot;) this.value = &quot;&quot;;">$valbody_t</textarea></td>
</tr>
<tr>
<th class="th" scope="row"><label for="$colbody_h">$markbody_h$labelbody_h</label></th>
<td$colspan><textarea id="$colbody_h" name="$colbody_h" cols="$cols" rows="$rows"
onfocus="if (this.value == &quot;$hbody_hdef&quot;) this.value = &quot;&quot;;">$valbody_h</textarea></td>
</tr>
<tr>
<th class="th" scope="row"><label for="$colhid">$markhid$labelhid</label></th>
<td$colspan><input id="$colhid" type="checkbox" name="$colhid"$valhid />
<label for="$colhid">$texthid</label></td>
EOT
}
print join("</tr>\n<tr>\n", @_);
print << "EOT";
</tr>
EOT
# A form to edit a current item
} elsif ($self->{"type"} eq "cur") {
# Find the last filled article
$rows_cur = $current->param("artcount") > 0?
$current->param("artcount") * 5: 1;
for ($_ = 0; defined $form->param("art$_" . "title"); $_++) {}
for ($_-- ; $_ >= 0
&& $form->param("art$_" . "title") eq ""
&& $form->param("art$_" . "author") eq ""
&& $form->param("art$_" . "body_t") eq ""
&& $form->param("art$_" . "body_h") eq ""; $_--) {}
$count_new = $_ + 1 + 3;
$rows_new = $count_new * 5;
$rowspan = $rows_cur + $rows_new;
$rows_cur = $rows_cur > 1? " rowspan=\"" . h($rows_cur) . "\"": "";
$rows_new = $rows_new > 1? " rowspan=\"" . h($rows_new) . "\"": "";
$rowspan = $rowspan > 1? " rowspan=\"" . h($rowspan) . "\"": "";
$label = h_abbr(__("[numerate,_1,Article]:", 0));
$orig = h_abbr(__("Original:"));
$new = h_abbr(__("New:"));
print << "EOT";
<tr>
<th class="th"$rowspan scope="row"><label for="art0title">$mark$label</label></th>
<th class="oldnew"$rows_cur scope="row">$orig</th>
EOT
for ($_ = 0, @_ = qw(); $_ < $current->param("artcount"); $_++) {
my ($curtitle, $curauthor, $curbody_t, $curbody_h, $curhid);
$no = h($_ + 1);
$col = "art$_";
$curtitle = h_abbr($current->param($col . "title"));
$curauthor = h_abbr($current->param($col . "author"));
$curbody_t = a2html($current->param($col . "body_t"));
$curbody_h = a2html($current->param($col . "body_h"));
$curhid = $self->{"cur"}->param($col . "hid")? $true: $false;
push @_, << "EOT";
<td rowspan="5" scope="row">$no</td>
<th class="th" scope="row">$marktitle$labeltitle</th>
<td$colspan>$curtitle</td>
</tr>
<tr>
<th class="th" scope="row">$markauthor$labelauthor</th>
<td$colspan>$curauthor</td>
</tr>
<tr>
<th class="th" scope="row">$markbody_t$labelbody_t</th>
<td$colspan>$curbody_t</td>
</tr>
<tr>
<th class="th" scope="row">$markbody_h$labelbody_h</th>
<td$colspan>$curbody_h</td>
</tr>
<tr>
<th class="th" scope="row">$markhid$labelhid</th>
<td$colspan>$curhid</td>
EOT
}
print @_ > 0? join("</tr>\n<tr>\n", @_):
" <td" . $self->_colspan . ">" . h_abbr(t_none) . "</td>\n";
print << "EOT";
</tr>
<tr>
<th class="oldnew"$rows_new scope="row"><label for="art0title">$new</label></th>
EOT
for ($_ = 0, @_ = qw(); $_ < $count_new; $_++) {
my ($coltitle, $colauthor, $colbody_t, $colbody_h, $colhid);
my ($valtitle, $valauthor, $valbody_t, $valbody_h, $valhid);
$col = "art$_";
$val = $self->_val_check($col);
$valtitle = $self->_val_text($col . "title");
$coltitle = h($col . "title");
$valauthor = $self->_val_text($col . "author");
$colauthor = h($col . "author");
$valbody_t = $self->_val_textarea($col . "body_t", $hbody_tdef);
$colbody_t = h($col . "body_t");
$valbody_h = $self->_val_textarea($col . "body_h", $hbody_hdef);
$colbody_h = h($col . "body_h");
$valhid = $self->_val_check($col . "hid");
$colhid = h($col . "hid");
$col = h($col);
push @_, << "EOT";
<td rowspan="5"><input id="$col" type="checkbox" name="$col"$val /></td>
<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="$colauthor">$markauthor$labelauthor</label></th>
<td$colspan><input id="$colauthor" class="text" type="text" name="$colauthor"$valauthor /></td>
</tr>
<tr>
<th class="th" scope="row"><label for="$colbody_t">$markbody_t$labelbody_t</label></th>
<td$colspan><textarea id="$colbody_t" name="$colbody_t" cols="$cols" rows="$rows"
onfocus="if (this.value == &quot;$hbody_tdef&quot;) this.value = &quot;&quot;;">$valbody_t</textarea></td>
</tr>
<tr>
<th class="th" scope="row"><label for="$colbody_h">$markbody_h$labelbody_h</label></th>
<td$colspan><textarea id="$colbody_h" name="$colbody_h" cols="$cols" rows="$rows"
onfocus="if (this.value == &quot;$hbody_hdef&quot;) this.value = &quot;&quot;;">$valbody_h</textarea></td>
</tr>
<tr>
<th class="th" scope="row"><label for="$colhid">$markhid$labelhid</label></th>
<td$colspan><input id="$colhid" type="checkbox" name="$colhid"$valhid />
<label for="$colhid">$texthid</label></td>
EOT
}
print join("</tr>\n<tr>\n", @_);
print << "EOT";
</tr>
EOT
# A form to delete a current item
} else {
# Find the last filled article
$rows_cur = $current->param("artcount") > 0?
$current->param("artcount") * 5: 1;
$rows_cur = $rows_cur > 1? " rowspan=\"" . h($rows_cur) . "\"": "";
$label = h_abbr(__("[numerate,_1,Article]:", $current->param("artcount")));
print << "EOT";
<tr>
<th class="th"$rows_cur scope="row">$mark$label</th>
EOT
for ($_ = 0, @_ = qw(); $_ < $current->param("artcount"); $_++) {
my ($curtitle, $curauthor, $curbody_t, $curbody_h, $curhid);
$no = h($_ + 1);
$col = "art$_";
$curtitle = h_abbr($current->param($col . "title"));
$curauthor = h_abbr($current->param($col . "author"));
$curbody_t = a2html($current->param($col . "body_t"));
$curbody_h = a2html($current->param($col . "body_h"));
$curhid = $self->{"cur"}->param($col . "hid")? $true: $false;
push @_, << "EOT";
<td rowspan="5">$no</td>
<th class="th" scope="row">$marktitle$labeltitle</th>
<td$colspan>$curtitle</td>
</tr>
<tr>
<th class="th" scope="row">$markauthor$labelauthor</th>
<td$colspan>$curauthor</td>
</tr>
<tr>
<th class="th" scope="row">$markbody_t$labelbody_t</th>
<td$colspan>$curbody_t</td>
</tr>
<tr>
<th class="th" scope="row">$markbody_h$labelbody_h</th>
<td$colspan>$curbody_h</td>
</tr>
<tr>
<th class="th" scope="row">$markhid$labelhid</th>
<td$colspan>$curhid</td>
EOT
}
print @_ > 0? join("</tr>\n<tr>\n", @_):
" <td" . $self->_colspan . ">" . h_abbr(t_none) . "</td>\n";
print << "EOT";
</tr>
EOT
}
return;
}
# _html_col_cred_t: The credits, in plain text
sub _html_col_cred_t : method {
$_[0]->_html_coltmpl_textarea("cred_t", h_abbr(__("Credits (text):")),
h(__("Fill in the credits in plain text here.")));
}
# _html_col_cred_h: The credits, in HTML
sub _html_col_cred_h : method {
$_[0]->_html_coltmpl_textarea("cred_h", h_abbr(__("Credits (HTML):")),
h(__("Fill in the credits in HTML 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_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;
}
return 1;

57
htdocs/wov/magicat/lib/perl5/Selima/wov/Form/Page.pm Normal file
View File

@@ -0,0 +1,57 @@
# Woman's Voice
# Page.pm: The web page 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-05
package Selima::wov::Form::Page;
use 5.008;
use strict;
use warnings;
use base qw(Selima::Form::Page);
use Selima::FormFunc;
use Selima::HTTP;
# 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"};
if (!exists $$args{"cols"}) {
# A form to create a new item
if ($$args{"type"} eq "new") {
$$args{"cols"} = [qw(path ord title title_en body 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 path ord title title_en body kw html hid
created createdby updated updatedby)];
}
}
$self = $class->SUPER::new($status, $args);
return $self;
}
return 1;

1152
htdocs/wov/magicat/lib/perl5/Selima/wov/HTML.pm Normal file
View File

File diff suppressed because it is too large Load Diff

130
htdocs/wov/magicat/lib/perl5/Selima/wov/Items.pm Normal file
View File

@@ -0,0 +1,130 @@
# Woman's Voice
# Items.pm: The data record related subroutines.
# 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-23
package Selima::wov::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);
@EXPORT_OK = @EXPORT;
# Prototype declaration
sub new_nl_no();
sub newslet_textno($);
sub newslet_title($);
sub newslet_no($);
}
use Encode qw(encode);
use Selima::ChkFunc;
use Selima::CommText;
use Selima::DataVars qw(:db);
# 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;
return sprintf "第%03d期", $_;
}
# newslet_title: Obtain a newsletter title
sub newslet_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
@_ = qw();
$_ = "CASE no WHEN 1 THEN '創刊號' ELSE "
. $DBH->strcat("'第'", "lpad(cast(no AS text), 3, 0)", "'期'") . " END";
push @_, encode("UTF-8", $_);
push @_, "' '";
push @_, "title";
push @_, "' '";
push @_, "extract(year FROM date)";
push @_, "'.'";
push @_, "lpad(cast(extract(month FROM date) AS text), 2, 0)";
push @_, "'.'";
push @_, "lpad(cast(extract(day FROM date) AS text), 2, 0)";
$_ = $DBH->strcat(@_) . " AS title";
$sql = "SELECT $_ 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];
}
# 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];
}
no utf8;
return 1;

38
htdocs/wov/magicat/lib/perl5/Selima/wov/L10N.pm Normal file
View File

@@ -0,0 +1,38 @@
# Woman's Voice
# 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::wov::L10N;
use 5.008;
use strict;
use warnings;
use base qw(Locale::Maketext::Gettext);
return 1;
# The Chinese (Taiwan) localized messages.
package Selima::wov::L10N::zh_tw;
use 5.008;
use strict;
use warnings;
use base qw(Locale::Maketext::Gettext);
sub numerate : method { $_[2] }
return 1;

47
htdocs/wov/magicat/lib/perl5/Selima/wov/List/Guestbook.pm Normal file
View File

@@ -0,0 +1,47 @@
# Woman's Voice
# 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::wov::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 Your Voice");
# Column labels
$self->col_labels(
"identity" => __("What kind of women you are?"),
);
return $self;
}
return 1;

36
htdocs/wov/magicat/lib/perl5/Selima/wov/List/Guestbook/Public.pm Normal file
View File

@@ -0,0 +1,36 @@
# Woman's Voice
# 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::wov::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;

99
htdocs/wov/magicat/lib/perl5/Selima/wov/List/NLArts.pm Normal file
View File

@@ -0,0 +1,99 @@
# Woman's Voice
# NLArts.pm: The newsletter article 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-11-24
package Selima::wov::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");
# The default sort order
$self->{"DEFAULT_SORTBY"} = "-newslet,ord";
# Columns that should display its brief instead
push @{$self->{"COLS_BRIEF"}}, qw(body_t body_h);
# Column labels
$self->col_labels(
"newslet" => __("Newsletter"),
"author" => __("Author"),
"body_t" => __("Content (text)"),
"body_h" => __("Content (HTML)"),
);
return $self;
}
# html_newlink: Display a link to add a new item
sub html_newlink : method {
# Run the parent method
return $_[0]->SUPER::html_newlink(__("Write a new article."));
}
# html_search: Display the search box
sub html_search : method {
# Run the parent method
return $_[0]->SUPER::html_search(__("Search for a 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;

98
htdocs/wov/magicat/lib/perl5/Selima/wov/List/Newslets.pm Normal file
View File

@@ -0,0 +1,98 @@
# Woman's Voice
# Newslets.pm: The newsletter 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-11-17
package Selima::wov::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(cred_t cred_h);
# Column labels
$self->col_labels(
"no" => __("Issue"),
"cred_t" => __("Credits (text)"),
"cred_h" => __("Credits (HTML)"),
);
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;

194
htdocs/wov/magicat/lib/perl5/Selima/wov/List/Search.pm Normal file
View File

@@ -0,0 +1,194 @@
# Woman's Voice
# Search.pm: The web site full-text search result 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-11-28
package Selima::wov::List::Search;
use 5.008;
use utf8;
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"} = "女聲全文檢索";
$self->{"etitle"} = "Website Search";
} else {
$self->{"title"} = "全文檢索結果";
$self->{"etitle"} = "Search Result";
}
$self->{"view"} = "search_list";
$self->{"COLS_NO_SEARCH"} = [qw(section path nlpath html piority)];
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 "newsletters") {
my ($title, $author, $newsletter, $nlurl);
$title = h($$current{"title"});
$author = h($$current{"author"});
$newsletter = h($$current{"newsletter"});
$nlurl = h($$current{"nlpath"});
print << "EOT";
<li><h3><a href="$url">$title</a> <span class="note">$author</span></h3>
<address><a href="$nlurl">$newsletter</a></address>
EOT
} elsif ($$current{"section"} eq "guestbook") {
my ($author, $date);
$author = defined $$current{"author"}?
" <span class=\"note\">" . h($$current{"author"}) . "</span>": "";
$date = h($$current{"date"});
print << "EOT";
<li><h3><a href="$url">$date 留言</a>$author</h3>
<address><a href="/cgi-bin/guestbook.cgi">妳的女聲</a></address>
EOT
} elsif ($$current{"section"} eq "links") {
my $title;
$title = h($$current{"title"});
print << "EOT";
<li><h3><a href="$url">$title</a></h3>
<address><a href="/links/">女網牽手</a></address>
EOT
} elsif ($$current{"section"} eq "pages") {
my $title;
$title = h($$current{"title"});
print << "EOT";
<li><h3><a href="$url">$title</a></h3>
EOT
}
print "\n<p>$abstract</p>\n" if defined $abstract;
print << "EOT";
</li>
EOT
}
print << "EOT";
</ol>
EOT
return;
}
no utf8;
return 1;

142
htdocs/wov/magicat/lib/perl5/Selima/wov/Processor/Guestbook/Public.pm Normal file
View File

@@ -0,0 +1,142 @@
# Woman's Voice
# 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::wov::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::GeoIP;
use Selima::Guest;
use Selima::RemoHost;
use Selima::Unicode;
use Selima::ShortCut;
# 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 .= "信箱： " . $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("editors\@mail.wov.idv.tw", "女聲編輯");
$mail->subject("[女聲] 留言本留言通知 " . 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;

70
htdocs/wov/magicat/lib/perl5/Selima/wov/Processor/LinkCat.pm Normal file
View File

@@ -0,0 +1,70 @@
# Woman's Voice
# LinkCat.pm: The related-link category 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-05
package Selima::wov::Processor::LinkCat;
use 5.008;
use strict;
use warnings;
use base qw(Selima::Processor::LinkCat);
use Selima::DataVars qw(:addcol);
# _save_cols: Save the column deposit
sub _save_cols : method {
local ($_, %_);
my ($self, $form, $cur);
$self = $_[0];
($form, $cur) = ($self->{"form"}, $self->{"cur"});
if ($self->{"type"} ne "del") {
# Set the "topmost" parent
$form->delete("parent") if $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("parent", $self->_form("parent"));
$self->{"cols"}->addstr("id", $self->_form("id"));
$self->{"cols"}->addnum("ord", $self->_form("ord"));
$self->{"cols"}->addstr("title", $self->_form("title"));
$self->{"cols"}->addstr("title_en", $self->_form("title_en"));
$self->{"cols"}->addstr("kw", $self->_form("kw"));
$self->{"cols"}->addbool("hid", $self->_form("hid"));
# Automatic Traditional Chinese to Simplified Chinese conversion
$self->_zhsync;
# A form to edit a current item
} elsif ($self->{"type"} eq "cur") {
$self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
$self->{"cols"}->addnum("parent", $self->_form("parent"), scalar $cur->param("parent"));
$self->{"cols"}->addstr("id", $self->_form("id"), scalar $cur->param("id"));
$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_en", $self->_form("title_en"), scalar $cur->param("title_en"));
$self->{"cols"}->addstr("kw", $self->_form("kw"), scalar $cur->param("kw"));
$self->{"cols"}->addbool("hid", $self->_form("hid"), scalar $cur->param("hid"));
# Automatic Traditional Chinese to Simplified Chinese conversion
$self->_zhsync;
}
return;
}
return 1;

151
htdocs/wov/magicat/lib/perl5/Selima/wov/Processor/NLArt.pm Normal file
View File

@@ -0,0 +1,151 @@
# Woman's Voice
# 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-03-19
package Selima::wov::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::wov::Items;
use Selima::wov::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("author", $self->_form("author"));
$self->{"cols"}->addstr("body_t", $self->_form("body_t"));
$self->{"cols"}->addstr("body_h", $self->_form("body_h"));
$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("author", $self->_form("author"), scalar $cur->param("author"));
$self->{"cols"}->addstr("body_t", $self->_form("body_t"), scalar $cur->param("body_t"));
$self->{"cols"}->addstr("body_h", $self->_form("body_h"), scalar $cur->param("body_h"));
$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";
}
# _rebuild_partial_pages: Rebuild a limited part of pages
sub _rebuild_partial_pages : method {
local ($_, %_);
my ($self, $form, $cur);
$self = $_[0];
($form, $cur) = ($self->{"form"}, $self->{"cur"});
# Find the affected shown parts
%_ = qw();
# A form to create a new item
if ($self->{"type"} eq "new") {
$_{$form->param("newslet")} = 1 unless defined $form->param("hid");
# A form to edit a current item
} elsif ($self->{"type"} eq "cur") {
$_{$form->param("newslet")} = 1 unless defined $form->param("hid");
$_{$cur->param("newslet")} = 1 unless $cur->param("hid");
# A form to delete a current item
} elsif ($self->{"type"} eq "del") {
$_{$cur->param("newslet")} = 1 unless $cur->param("hid");
}
@_ = keys %_;
# Nothing to rebuild when no shown parts are seen
return if @_ == 0;
# Rebuild the pages
rebuild_newslets @_;
return;
}
return 1;

263
htdocs/wov/magicat/lib/perl5/Selima/wov/Processor/Newslet.pm Normal file
View File

@@ -0,0 +1,263 @@
# Woman's Voice
# 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-03-19
package Selima::wov::Processor::Newslet;
use 5.008;
use strict;
use warnings;
use base qw(Selima::Processor);
use Selima::DataVars qw(:addcol :dataman);
use Selima::Guest;
use Selima::ShortCut;
use Selima::wov::Rebuild;
use Selima::wov::Processor::NLArt;
use Selima::Processor::Deletion;
# 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("cred_t", $self->_form("cred_t"));
$self->{"cols"}->addstr("cred_h", $self->_form("cred_h"));
$self->{"cols"}->addstr("kw", $self->_form("kw"));
$self->{"cols"}->addbool("hid", $self->_form("hid"));
# Find the changed items
for ($_ = 0, $o = 1; defined $form->param("art$_" . "title"); $_++) {
my ($subform, $cols);
# Not selected
next unless defined $form->param("art$_");
$subform = new CGI("");
$subform->param("form", "new");
$subform->param("newslet", $self->{"sn"});
$subform->param("ord", $o++);
$subform->param("title", $form->param("art$_" . "title"));
$subform->param("author", $form->param("art$_" . "author"));
$subform->param("body_t", $form->param("art$_" . "body_t"));
$subform->param("body_h", $form->param("art$_" . "body_h"));
$subform->param("hid", $form->param("art$_" . "hid"));
$cols = new Selima::wov::Processor::NLArt($subform);
$cols->_save_cols;
push @{$self->{"subs"}}, $cols;
}
# 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("cred_t", $self->_form("cred_t"), scalar $cur->param("cred_t"));
$self->{"cols"}->addstr("cred_h", $self->_form("cred_h"), scalar $cur->param("cred_h"));
$self->{"cols"}->addstr("kw", $self->_form("kw"), scalar $cur->param("kw"));
$self->{"cols"}->addbool("hid", $self->_form("hid"), scalar $cur->param("hid"));
# Find the changed items
@_ = qw();
for ( $_ = 0, $o = 1;
$_ < $cur->param("artcount")
|| defined $form->param("art$_" . "title");
$_++) {
# Added items to the current
if ($_ >= $cur->param("artcount")) {
my ($subform, $cols);
# Not selected
next unless defined $form->param("art$_");
$subform = new CGI("");
$subform->param("form", "new");
$subform->param("newslet", $self->{"sn"});
$subform->param("ord", $o++);
$subform->param("title", $form->param("art$_" . "title"));
$subform->param("author", $form->param("art$_" . "author"));
$subform->param("body_t", $form->param("art$_" . "body_t"));
$subform->param("body_h", $form->param("art$_" . "body_h"));
$subform->param("hid", $form->param("art$_" . "hid"));
$cols = new Selima::wov::Processor::NLArt($subform);
$cols->_save_cols;
push @{$self->{"subs"}}, $cols;
# Selected
} elsif (defined $form->param("art$_")) {
my ($subform, $cols, %CURRENT_SUP);
%CURRENT_SUP = %CURRENT;
%CURRENT = (
"sn" => $cur->param("art$_" . "sn"),
"newslet" => $self->{"sn"},
"ord" => $cur->param("art$_" . "ord"),
"title" => $cur->param("art$_" . "title"),
"author" => $cur->param("art$_" . "author"),
"body_t" => $cur->param("art$_" . "body_t"),
"body_h" => $cur->param("art$_" . "body_h"),
"hid" => $cur->param("art$_" . "hid"),
);
$subform = new CGI("");
$subform->param("form", "cur");
$subform->param("sn", $cur->param("art$_" . "sn"));
$subform->param("newslet", $self->{"sn"});
$subform->param("ord", $o++);
$subform->param("title", $form->param("art$_" . "title"));
$subform->param("author", $form->param("art$_" . "author"));
$subform->param("body_t", $form->param("art$_" . "body_t"));
$subform->param("body_h", $form->param("art$_" . "body_h"));
$subform->param("hid", $form->param("art$_" . "hid"));
$cols = new Selima::wov::Processor::NLArt($subform);
$cols->_save_cols;
push @{$self->{"subs"}}, $cols;
%CURRENT = %CURRENT_SUP;
# Not selected
} else {
push @_, $cur->param("art$_" . "sn");
}
}
if (@_ > 0) {
my $subform;
$_ = join " OR ", map "sn=$_", @_;
$subform = new CGI("");
$subform->param("cond", $_);
# Delete first, to spare the order occupied
unshift @{$self->{"subs"}}, new Selima::Processor::Deletion($subform, "nlarts");
}
# 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";
}
# _rebuild_partial_pages: Rebuild a limited part of pages
sub _rebuild_partial_pages : method {
local ($_, %_);
my ($self, $form, $cur);
my $build_me_only;
$self = $_[0];
($form, $cur) = ($self->{"form"}, $self->{"cur"});
# Remove the unwanted pages
$self->_remove_curfile;
# Check if there is any shown part affected
# A form to create a new item
if ($self->{"type"} eq "new") {
return if defined $form->param("hid");
$build_me_only = 0;
# A form to edit a current item
} elsif ($self->{"type"} eq "cur") {
return if $cur->param("hid") && defined $form->param("hid");
$build_me_only = (!$cur->param("hid") && !defined $form->param("hid"));
# A form to delete a current item
} elsif ($self->{"type"} eq "del") {
return if $cur->param("hid");
$build_me_only = 0;
}
if ($build_me_only) {
rebuild_newslets $self->{"sn"};
# Rebuild everything, since the page bar changed
} else {
rebuild_newslets;
}
}
# _remove_curfile: Remove the unwanted page
sub _remove_curfile : method {
local ($_, %_);
my ($self, $form, $cur);
$self = $_[0];
($form, $cur) = ($self->{"form"}, $self->{"cur"});
# Nothing to remove if there is no current page
return if $self->{"type"} eq "new" || $cur->param("hid");
# A current page to be deleted or hidden
return grmoldpage sprintf "/newsletters/wov%04d.html", $cur->param("no")
if $self->{"type"} eq "del" || defined $form->param("hid");
# A shown page update with a new page path to check with
# Page path is not updated
return;
}
return 1;

68
htdocs/wov/magicat/lib/perl5/Selima/wov/Processor/Page.pm Normal file
View File

@@ -0,0 +1,68 @@
# Woman's Voice
# Page.pm: The web page form 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-05
package Selima::wov::Processor::Page;
use 5.008;
use strict;
use warnings;
use base qw(Selima::Processor::Page);
use Selima::DataVars qw(:addcol);
# _save_cols: Save the column deposit
sub _save_cols : method {
local ($_, %_);
my ($self, $form, $cur);
$self = $_[0];
($form, $cur) = ($self->{"form"}, $self->{"cur"});
# A form to create a new item
if ($self->{"type"} eq "new") {
$self->{"sn"} = $self->_new_sn;
$self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_INSERT);
$self->{"cols"}->addnum("sn", $self->{"sn"});
$self->{"cols"}->addstr("path", $self->_form("path"));
$self->{"cols"}->addnum("ord", $self->_form("ord"));
$self->{"cols"}->addstr("title", $self->_form("title"));
$self->{"cols"}->addstr("title_en", $self->_form("title_en"));
$self->{"cols"}->addstr("body", $self->_form("body"));
$self->{"cols"}->addstr("kw", $self->_form("kw"));
$self->{"cols"}->addbool("html", $self->_form("html"));
$self->{"cols"}->addbool("hid", $self->_form("hid"));
# Automatic Traditional Chinese to Simplified Chinese conversion
$self->_zhsync;
# A form to edit a current item
} elsif ($self->{"type"} eq "cur") {
$self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
$self->{"cols"}->addstr("path", $self->_form("path"), scalar $cur->param("path"));
$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_en", $self->_form("title_en"), scalar $cur->param("title_en"));
$self->{"cols"}->addstr("body", $self->_form("body"), scalar $cur->param("body"));
$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"));
# Automatic Traditional Chinese to Simplified Chinese conversion
$self->_zhsync;
}
return;
}
return 1;

441
htdocs/wov/magicat/lib/perl5/Selima/wov/Rebuild.pm Normal file
View File

@@ -0,0 +1,441 @@
# Woman's Voice
# 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::wov::Rebuild;
use 5.008;
use utf8;
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::wov::HTML;
use Selima::wov::Items;
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 newsletters
rebuild_newslets;
# 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",
"javascripts" => [qw(/scripts/links.js)],
"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 "女網牽手", "Woman Interconnect", $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 ($_, %_);
my (@newslets, $sql, $sth, $count, $FD, $rebuild_everything);
my ($lang, $args, $html, @allno);
@newslets = @_;
$lang = getlang;
# Obtain all the pages
{
my ($sql, $sth, $count);
$sql = "SELECT no FROM newslets"
. " WHERE NOT hid ORDER BY no;\n";
$sth = $DBH->prepare($sql);
$sth->execute;
$count = $sth->rows;
for (my $i = 0, @allno = qw(); $i < $count; $i++) {
push @allno, ${$sth->fetch}[0];
}
undef $sth;
}
# Rebuild everything
$rebuild_everything = (@newslets == 0);
if ($rebuild_everything) {
$sql = "SELECT * FROM newslets"
. " WHERE NOT hid ORDER BY no;\n";
} else {
$_ = join " OR ", map "sn=$_", @newslets;
$_ = "($_)" if @newslets > 1;
$sql = "SELECT * FROM newslets"
. " WHERE $_"
. " AND NOT hid"
. " ORDER BY no;\n";
}
$sth = $DBH->prepare($sql);
$sth->execute;
$count = $sth->rows;
for (my $i = 0; $i < $count; $i++) {
my ($page, $sql1, $sth1, $count1, $row1, $title, $pagebar);
$page = $sth->fetchrow_hashref;
$$page{"path"} = sprintf "/newsletters/wov%04d.html", $$page{"no"};
$title = newslet_textno($$page{"no"}) . " " . $$page{"title"};
$$page{"allno"} = [@allno];
# Find the belonging articles
$sql1 = "SELECT * FROM nlarts"
. " WHERE newslet=" . $$page{"sn"}
. " AND NOT hid"
. " ORDER BY ord;\n";
$sth1 = $DBH->prepare($sql1);
$sth1->execute;
$count1 = $sth1->rows;
for (my $i = 0, $$page{"arts"} = []; $i < $count1; $i++) {
push @{$$page{"arts"}}, $sth1->fetchrow_hashref;
}
$html = compose_page($page, $lang);
goutpage $html, $$page{"path"}, $lang;
}
# Build the index page
$sql = "SELECT sn, no, date, title FROM newslets"
. " WHERE NOT hid ORDER BY no DESC;\n";
$sth = $DBH->prepare($sql);
$sth->execute;
$count = $sth->rows;
for ($_ = 0, @_ = qw(); $_ < $count; $_++) {
my ($newslet, $sql1, $sth1, $count1);
$newslet = $sth->fetchrow_hashref;
# Find the belonging articles
$sql1 = "SELECT title, author FROM nlarts"
. " WHERE newslet=" . $$newslet{"sn"}
. " AND NOT hid"
. " ORDER BY ord;\n";
$sth1 = $DBH->prepare($sql1);
$sth1->execute;
$count1 = $sth1->rows;
for (my $i = 0, $$newslet{"arts"} = []; $i < $count1; $i++) {
push @{$$newslet{"arts"}}, $sth1->fetchrow_hashref;
}
push @_, $newslet;
}
$ALT_PAGE_PARAM = {
"path" => "/newsletters/",
"lang" => $lang,
"keywords" => "女聲電子報, 女性主義, 婦運, 性別, 小招, 依瑪貓",
"javascripts" => [qw(/scripts/search.js)],
"class" => "newsletters",
"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 "女聲各期目錄", "Index of WOVs", $args;
html_nl_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, "/newsletters/", $lang;
return;
}
# compose_page: Compose a page
sub compose_page($;$) {
local ($_, %_);
my ($page, $lang, $args, $title_en, $FD);
($page, $lang) = @_;
$lang = getlang if !defined $lang;
$ALT_PAGE_PARAM = {
"path" => $$page{"path"},
"lang" => $lang,
"keywords" => $$page{"kw"},
"static" => 1,
"all_linguas" => [$lang],
"no_auto_title" => exists $$page{"no_auto_title"}
&& $$page{"no_auto_title"}};
$$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"} =~ /^\/newsletters\//) {
$$ALT_PAGE_PARAM{"class"} = "newsletters";
} elsif ($$page{"path"} =~ /^\/links\//) {
$$ALT_PAGE_PARAM{"class"} = "links";
}
if ($$page{"path"} eq "/subscribe.html") {
$$ALT_PAGE_PARAM{"javascripts"} = ["/scripts/subscribe.js"];
}
$args = page_param;
$title_en = exists $$page{"title_en"} && defined $$page{"title_en"}?
$$page{"title_en"}: undef;
# Special rules for newsletters
if ($$page{"path"} =~ /^\/newsletters\/wov\d{4}\.html$/) {
$$args{"no_auto_title"} = 1;
# The relative pages
$$args{"first"} = sprintf "/newsletters/wov%04d.html", ${$$page{"allno"}}[0];
for ($_ = 0; $_ < @{$$page{"allno"}}; $_++) {
last if ${$$page{"allno"}}[$_] == $$page{"no"};
}
$$args{"prev"} = sprintf "/newsletters/wov%04d.html", ${$$page{"allno"}}[$_ - 1]
if $_ > 0;
$$args{"next"} = sprintf "/newsletters/wov%04d.html", ${$$page{"allno"}}[$_ + 1]
if $_ < $#{$$page{"allno"}};
$$args{"last"} = sprintf "/newsletters/wov%04d.html", ${$$page{"allno"}}[$#{$$page{"allno"}}];
# Obtain the page bar
IO::NestedCapture->start(CAPTURE_STDOUT);
binmode IO::NestedCapture->instance->{"STDOUT_current"}[-1], ":utf8";
html_nl_pagebar $_, @{$$page{"allno"}}, $args;
IO::NestedCapture->stop(CAPTURE_STDOUT);
$FD = IO::NestedCapture->get_last_out;
$_ = join "", <$FD>;
if ($_ ne "") {
$$args{"header_html_nav"} = $_;
$$args{"footer_html_nav"} = $_;
}
}
# Obtain the page
IO::NestedCapture->start(CAPTURE_STDOUT);
binmode IO::NestedCapture->instance->{"STDOUT_current"}[-1], ":utf8";
html_header $$page{"title"}, $title_en, $args;
if ($$page{"path"} =~ /^\/newsletters\/wov\d{4}\.html$/) {
html_title "女聲", "Woman’s Voice";
html_newslet $page, $args;
} elsif ($$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 $_;
}
no utf8;
return 1;