Files
2026-03-10 21:31:43 +08:00

272 lines
7.9 KiB
Perl
Executable File

#! /usr/bin/perl -w
# Woman's Voice
# newslets.cgi: The newsletter administration.
# Copyright (c) 2004-2021 imacat.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
# Author: imacat <imacat@mail.imacat.idv.tw>
# First written: 2004-11-17
use 5.008;
use strict;
use warnings;
use lib $ENV{"DOCUMENT_ROOT"} . qw(/magicat/lib/perl5);
use Selima::wov;
local $SIG{"__DIE__"} = \&http_500;
my $d = new Selima::Destroy;
# Prototype declaration
sub main();
sub check_get();
sub check_post();
sub html_page($);
sub fetch_curitem();
use Date::Parse qw(str2time);
initenv(-restricted => 1,
-this_table => "newslets",
-dbi_lock => {"newslets" => LOCK_EX,
"nlarts" => LOCK_EX},
-lastmod => 1,
-page_param => {"keywords" => N_("newsletters")});
main;
exit 0;
sub main() {
local ($_, %_);
my ($error, $success, $processor);
# If the request is a GET query
if ($ENV{"REQUEST_METHOD"} ne "POST") {
$error = check_get;
# If an error occurs
if (defined $error) {
html_page $error;
# Display the page
} else {
html_page retrieve_status;
}
# If a form was POSTed from the client
} else {
$error = check_post;
# If an error occurs
if (defined $error) {
error_redirect $error;
# Else, save the data
} else {
$processor = new Selima::wov::Processor::Newslet($POST);
$success = $processor->process;
success_redirect $success;
}
}
return;
}
# check_get: Check the GET arguments
sub check_get() {
local ($_, %_);
my $error;
# A form is requested
if (is_form) {
$_ = form_type;
# A form to create a new item
if ($_ eq "new") {
# A form to edit a current item
} elsif ($_ eq "cur") {
# Check at fetch_curitem()
$error = fetch_curitem;
return $error if defined $error;
# A form to delete a current item
} elsif ($_ eq "del") {
# Check at fetch_curitem()
$error = fetch_curitem;
return $error if defined $error;
# A form to preview a submitted item
} elsif ($_ eq "preview") {
my ($sql, $sth, $count, $row, @allno);
# Check at fetch_preview()
$error = fetch_preview;
return $error if defined $error;
$PREVIEW{"path"} = sprintf "/newsletters/wov%04d.html", $PREVIEW{"no"};
$PREVIEW{"date"} = str2time $PREVIEW{"date"};
$PREVIEW{"title"} = newslet_textno($PREVIEW{"no"}) . " " . $PREVIEW{"title"};
# Obtain all the pages
@_ = qw();
push @_, "sn!=" . $PREVIEW{"sn"} if exists $PREVIEW{"sn"};
push @_, "NOT hid";
$sql = "SELECT no FROM newslets"
. " WHERE " . join(" AND ", @_)
. " 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;
# Insert this page
for ($_ = 0; $_ < @allno; $_++) {
last if $PREVIEW{"no"} < $allno[$_];
}
@allno = (
@allno[0..$_-1],
$PREVIEW{"no"},
@allno[$_..$#allno]);
$PREVIEW{"allno"} = [@allno];
# Not a valid form
} else {
return {"msg"=>N_("Incorrect form: [_1]."),
"margs"=>[$_],
"isform"=>0};
}
}
# List handler handles its own error
# OK
return;
}
# check_post: Check the POSTed form
sub check_post() {
local ($_, %_);
my ($checker, $error);
$_ = form_type;
# A form to create a new item
if ($_ eq "new") {
# Run the checker
$checker = new Selima::wov::Checker::Newslet(curform);
$error = $checker->check(qw(no date title cred_t cred_h kw arts));
return $error if defined $error;
# A form to edit a current item
} elsif ($_ eq "cur") {
# Check at fetch_curitem()
$error = fetch_curitem;
return $error if defined $error;
# Run the checker
$checker = new Selima::wov::Checker::Newslet(curform);
$checker->redir(qw(del));
$error = $checker->check(qw(no date title cred_t cred_h kw arts));
return $error if defined $error;
# A form to delete a current item
} elsif ($_ eq "del") {
# Check at fetch_curitem()
$error = fetch_curitem;
return $error if defined $error;;
# Run the checker
$checker = new Selima::wov::Checker::Newslet(curform);
$checker->redir(qw(cancel));
# Not a valid form
} else {
return {"msg"=>N_("Incorrect form: [_1]."),
"margs"=>[$_],
"isform"=>0};
}
# OK
return;
}
# html_page: Display the page
sub html_page($) {
local ($_, %_);
my ($status, $LIST, $FORM);
$status = $_[0];
# A form is requested
if (is_form $status) {
# A form to preview a submitted item
if (form_type eq "preview") {
html_preview;
} else {
$FORM = new Selima::wov::Form::Newslet($status);
html_header $FORM->{"title"};
html_errmsg $status;
$FORM->html;
html_footer;
}
# List the available items
} else {
$LIST = new Selima::wov::List::Newslets;
html_header $LIST->{"title"}, undef, $LIST->page_param;
html_errmsg $status;
$LIST->html;
html_footer;
}
return;
}
##################################
# Subroutines to manage the data #
##################################
# fetch_curitem: Fetch the current item
sub fetch_curitem() {
local ($_, %_);
my ($sn, $FORM, $sth, $sql, $row);
# Return if fetched before
return if scalar(keys %CURRENT) > 0;
# Obtain the current form
$FORM = curform;
# No item specified
return {"msg"=>N_("Please select the newsletter."),
"isform"=>0}
if !defined $FORM->param("sn");
$sn = $FORM->param("sn");
# Find the record
%CURRENT = fetchrec $sn, $THIS_TABLE;
# If this record exist
return {"msg"=>N_("This newsletter does not exist anymore. Please select another one."),
"isform"=>0}
if scalar(keys %CURRENT) == 0;
# Obtain the date
$CURRENT{"date"} = fmtdate $CURRENT{"date"};
# Obtain the articles list
$sql = "SELECT * FROM nlarts WHERE newslet=$sn ORDER BY ord;\n";
$sth = $DBH->prepare($sql);
$sth->execute;
$CURRENT{"artcount"} = $sth->rows;
for ($_ = 0; $_ < $CURRENT{"artcount"}; $_++) {
$row = $sth->fetchrow_hashref;
$CURRENT{"art$_"} = 1;
$CURRENT{"art$_" . "sn"} = $$row{"sn"};
$CURRENT{"art$_" . "ord"} = $$row{"ord"};
$CURRENT{"art$_" . "title"} = $$row{"title"};
$CURRENT{"art$_" . "author"} = $$row{"author"};
$CURRENT{"art$_" . "body_t"} = $$row{"body_t"};
$CURRENT{"art$_" . "body_h"} = $$row{"body_h"};
$CURRENT{"art$_" . "hid"} = $$row{"hid"};
}
# OK
return;
}