Initial commit.
This commit is contained in:
316
lib/perl5/Selima/Processor.pm
Normal file
316
lib/perl5/Selima/Processor.pm
Normal file
@@ -0,0 +1,316 @@
|
||||
# Selima Website Content Management System
|
||||
# Processor.pm: The base data processor.
|
||||
|
||||
# Copyright (c) 2005-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: 2005-06-30
|
||||
|
||||
package Selima::Processor;
|
||||
use 5.008;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Selima::AddCol;
|
||||
use Selima::DataVars qw($DBH :addcol :dataman :l10n);
|
||||
use Selima::GetLang;
|
||||
use Selima::Guest;
|
||||
use Selima::HTTP;
|
||||
use Selima::ShortCut;
|
||||
use Selima::Unicode;
|
||||
|
||||
# Load these classes
|
||||
use Selima::Processor::User;
|
||||
use Selima::Processor::Group;
|
||||
use Selima::Processor::UserMem;
|
||||
use Selima::Processor::GroupMem;
|
||||
use Selima::Processor::UserPref;
|
||||
use Selima::Processor::ScptPriv;
|
||||
use Selima::Processor::ListPref;
|
||||
|
||||
use Selima::Processor::Guestbook;
|
||||
use Selima::Processor::Page;
|
||||
use Selima::Processor::LinkCat;
|
||||
use Selima::Processor::Link;
|
||||
use Selima::Processor::LinkCatz;
|
||||
|
||||
use Selima::Processor::Rebuild;
|
||||
use Selima::Processor::Deletion;
|
||||
use Selima::Processor::LogOut;
|
||||
use Selima::Processor::Category;
|
||||
use Selima::Processor::Categorz;
|
||||
|
||||
use Selima::Processor::AcctSubj;
|
||||
use Selima::Processor::AcctTrx;
|
||||
use Selima::Processor::AcctRec;
|
||||
use Selima::Processor::ListPref::AcctReps;
|
||||
|
||||
# The relevent variables
|
||||
use constant NEWSN_LEN => 9;
|
||||
use vars qw($NEWSN_MIN $NEWSN_MAX $NEWSN_INT);
|
||||
$NEWSN_MIN = 10 ** (NEWSN_LEN - 1); # 100000000
|
||||
$NEWSN_MAX = (10 ** NEWSN_LEN) - 1; # 999999999
|
||||
$NEWSN_INT = $NEWSN_MAX - $NEWSN_MIN + 1;
|
||||
|
||||
# new: Initialize the processor
|
||||
sub new : method {
|
||||
local ($_, %_);
|
||||
my ($class, $form, $table, $self);
|
||||
($class, $form, $table) = @_;
|
||||
$self = bless {}, $class;
|
||||
$self->{"form"} = $form;
|
||||
$self->{"table"} = $table;
|
||||
$self->{"pres"} = [];
|
||||
$self->{"subs"} = [];
|
||||
$self->{"type"} = $self->{"form"}->param("form")
|
||||
if defined $self->{"form"}->param("form");
|
||||
$self->{"step"} = $self->{"form"}->param("step")
|
||||
if defined $self->{"form"}->param("step");
|
||||
$self->{"sn"} = $self->{"form"}->param("sn")
|
||||
if defined $self->{"form"}->param("sn");
|
||||
# The current item
|
||||
$self->{"cur"} = new CGI({%CURRENT});
|
||||
# The user request
|
||||
$self->{"req"} = new CGI({%REQUEST});
|
||||
$self->{"is_sql"} = 1;
|
||||
$self->{"update_timestamp"} = 1;
|
||||
return $self;
|
||||
}
|
||||
|
||||
# process: Process the form, fully
|
||||
sub process : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Submitted but not confirmed yet
|
||||
return {"preview"=>1} if !defined $self->{"form"}->param("confirm");
|
||||
|
||||
# Save the column deposit
|
||||
$self->_save_cols;
|
||||
# Not modified
|
||||
return $self->_ret_status unless $self->_modified;
|
||||
|
||||
# Begin the SQL transaction
|
||||
$DBH->begin_work if $self->{"is_sql"};
|
||||
# Update the columns
|
||||
$self->_update_cols;
|
||||
# Rebuild a limited part of pages
|
||||
$self->_rebuild_partial_pages;
|
||||
# Perform tasks other than column updates
|
||||
$self->_other_tasks;
|
||||
# Commit the SQL transaction
|
||||
$DBH->commit if $self->{"is_sql"};
|
||||
|
||||
# Log and return the process status
|
||||
$self->_actlog;
|
||||
return $self->_ret_status;
|
||||
}
|
||||
|
||||
###################
|
||||
# Methods belows are to be called by other processors. Do not call them directly.
|
||||
# Override them when needed.
|
||||
###################
|
||||
# _save_cols: Save the column deposit
|
||||
sub _save_cols : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
return unless exists $self->{"type"};
|
||||
# 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"});
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($self->{"type"} eq "cur") {
|
||||
$self->{"cols"} = new Selima::AddCol($self->{"table"}, ADDCOL_UPDATE);
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
###################
|
||||
# Methods belows are private. Do not call them directly.
|
||||
# Override them when needed.
|
||||
###################
|
||||
# _update_cols: Update the columns
|
||||
sub _update_cols : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Run the pre-processing sub-processors
|
||||
foreach (@{$self->{"pres"}}) {
|
||||
$_->_update_cols if $_->_modified;
|
||||
}
|
||||
|
||||
# Process the update
|
||||
if ($self->{"is_sql"} && exists $self->{"type"}) {
|
||||
# A form to create a new item
|
||||
if ($self->{"type"} eq "new" && exists $self->{"cols"}) {
|
||||
$_ = "INSERT INTO " . $self->{"table"}
|
||||
. " " . $self->{"cols"}->ret($self->{"update_timestamp"}) . ";\n";
|
||||
$DBH->gdo($_);
|
||||
|
||||
# A form to edit a current item
|
||||
} elsif ($self->{"type"} eq "cur" && exists $self->{"cols"} && exists $self->{"sn"}) {
|
||||
$_ = "UPDATE " . $self->{"table"}
|
||||
. " " . $self->{"cols"}->ret($self->{"update_timestamp"})
|
||||
. " WHERE sn=" . $self->{"sn"} . ";\n";
|
||||
$DBH->gdo($_);
|
||||
|
||||
# A form to delete a current item
|
||||
} elsif ($self->{"type"} eq "del" && exists $self->{"sn"}) {
|
||||
$_ = "DELETE FROM " . $self->{"table"}
|
||||
. " WHERE sn=" . $self->{"sn"} . ";\n";
|
||||
$DBH->gdo($_);
|
||||
}
|
||||
}
|
||||
|
||||
# Run the sub-processors
|
||||
foreach (@{$self->{"subs"}}) {
|
||||
$_->_update_cols if $_->_modified;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# _rebuild_partial_pages: Rebuild a limited part of pages
|
||||
# Empty by default. Put page building code here.
|
||||
sub _rebuild_partial_pages : method {}
|
||||
|
||||
# _other_tasks: Perform tasks other than column updates
|
||||
# Empty by default.
|
||||
sub _other_tasks : method {}
|
||||
|
||||
# _actlog: Log the activity
|
||||
sub _actlog : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# A form to create a new item
|
||||
return gactlog "Create a record with s/n " . $self->{"sn"} . "."
|
||||
if $self->{"type"} eq "new";
|
||||
# A form to edit a current item
|
||||
return gactlog "Update the record with s/n " . $self->{"sn"} . "."
|
||||
if $self->{"type"} eq "cur";
|
||||
# A form to delete a current item
|
||||
return gactlog "Delete the record 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 record was not modified."),
|
||||
"isform"=>0}
|
||||
if !$self->_modified;
|
||||
# A form to create a new item
|
||||
return {"msg"=>N_("This record has been successfully added."),
|
||||
"isform"=>0}
|
||||
if $self->{"type"} eq "new";
|
||||
# A form to edit a current item
|
||||
return {"msg"=>N_("This record has been successfully updated."),
|
||||
"isform"=>0}
|
||||
if $self->{"type"} eq "cur";
|
||||
# A form to delete a current item
|
||||
return {"msg"=>N_("This record has been successfully deleted."),
|
||||
"isform"=>0}
|
||||
if $self->{"type"} eq "del";
|
||||
}
|
||||
|
||||
# _form: Return a specific form value
|
||||
# Return undef if that column is empty
|
||||
sub _form : method {
|
||||
local ($_, %_);
|
||||
my ($self, $name);
|
||||
($self, $name) = @_;
|
||||
return scalar $self->{"form"}->param($name);
|
||||
}
|
||||
|
||||
###################
|
||||
# Methods belows are private. Do not call them directly.
|
||||
# Do not override them, either.
|
||||
###################
|
||||
# _modified: If the item is modified
|
||||
sub _modified : method {
|
||||
local ($_, %_);
|
||||
my $self;
|
||||
$self = $_[0];
|
||||
# Modification status checked before
|
||||
return $self->{"modified"} if exists $self->{"modified"};
|
||||
# Return true for addition and deletion processors
|
||||
return ($self->{"modified"} = 1)
|
||||
if exists $self->{"type"} && $self->{"type"} ne "cur";
|
||||
# Return true if the columns are modified
|
||||
return ($self->{"modified"} = 1)
|
||||
if exists $self->{"cols"} && $self->{"cols"}->modified;
|
||||
# Return true if any of the subprocessors is modified
|
||||
foreach (@{$self->{"pres"}}) {
|
||||
return ($self->{"modified"} = 1) if $_->_modified;
|
||||
}
|
||||
foreach (@{$self->{"subs"}}) {
|
||||
return ($self->{"modified"} = 1) if $_->_modified;
|
||||
}
|
||||
# Not modified
|
||||
return ($self->{"modified"} = 0);
|
||||
}
|
||||
|
||||
# _zhsync: Automatic Traditional Chinese to Simplified Chinese conversion
|
||||
sub _zhsync : method {
|
||||
local ($_, %_);
|
||||
my ($self, $form, $cur);
|
||||
$self = $_[0];
|
||||
($form, $cur) = ($self->{"form"}, $self->{"cur"});
|
||||
# Skip unless multilingual
|
||||
return unless @ALL_LINGUAS > 1;
|
||||
# Skip unless we are in Traditional Chinese, and there is Simplified Chinese
|
||||
%_ = map { $_ => 1 } @ALL_LINGUAS;
|
||||
return unless getlang eq "zh-tw" && exists $_{"zh-cn"};
|
||||
# A form to create a new item
|
||||
if ($self->{"type"} eq "new") {
|
||||
foreach my $col ($DBH->cols_ml($self->{"table"})) {
|
||||
$self->{"cols"}->addstr($col . "_zhcn", all_to_simp($_))
|
||||
if defined($_ = $form->param($col));
|
||||
}
|
||||
# A form to edit a current item
|
||||
} elsif ($self->{"type"} eq "cur") {
|
||||
foreach my $col ($DBH->cols_ml($self->{"table"})) {
|
||||
$self->{"cols"}->addstr($col . "_zhcn", all_to_simp($_), $cur->param($col . "_zhcn"))
|
||||
if defined($_ = $form->param($col));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# _new_sn: Generate a new random serial number for an SQL table
|
||||
sub _new_sn : method {
|
||||
local ($_, %_);
|
||||
my ($self, $sql, $sth);
|
||||
$self = $_[0];
|
||||
|
||||
do {
|
||||
# Generate a random serial number
|
||||
$_ = $NEWSN_MIN + int rand $NEWSN_INT;
|
||||
# Check if this serial number exists
|
||||
$sql = "SELECT sn FROM " . $self->{"table"}
|
||||
. " WHERE sn=$_;\n";
|
||||
$sth = $DBH->prepare($sql);
|
||||
$sth->execute;
|
||||
} until $sth->rows == 0;
|
||||
|
||||
return $_;
|
||||
}
|
||||
|
||||
return 1;
|
||||
Reference in New Issue
Block a user