338 lines
12 KiB
Perl
338 lines
12 KiB
Perl
# Selima Website Content Management System
|
|
# Link.pm: The related-link 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-18
|
|
|
|
package Selima::Processor::Link;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(Selima::Processor);
|
|
|
|
use CGI;
|
|
|
|
use Selima::DataVars qw($DBH :addcol :scptconf);
|
|
use Selima::Guest;
|
|
use Selima::Links;
|
|
use Selima::ShortCut;
|
|
|
|
use Selima::Processor::LinkCatz;
|
|
use Selima::Processor::Deletion;
|
|
|
|
# new: Initialize the processor
|
|
sub new : method {
|
|
local ($_, %_);
|
|
my ($self, $class);
|
|
($class, @_) = @_;
|
|
$_[1] = "links" if @_ < 2;
|
|
$self = $class->SUPER::new(@_);
|
|
return $self;
|
|
}
|
|
|
|
# _save_cols: Save the column deposit
|
|
sub _save_cols : method {
|
|
local ($_, %_);
|
|
my ($self, $form, $cur, @olditems, @newitems, @additems, @delitems);
|
|
$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("title", $self->_form("title"));
|
|
$self->{"cols"}->addstr("title_2ln", $self->_form("title_2ln"));
|
|
$self->{"cols"}->addurl("url", $self->_form("url"));
|
|
$self->{"cols"}->addstr("email", $self->_form("email"));
|
|
$self->{"cols"}->addurl("icon", $self->_form("icon"));
|
|
$self->{"cols"}->addstr("addr", $self->_form("addr"));
|
|
$self->{"cols"}->addstr("tel", $self->_form("tel"));
|
|
$self->{"cols"}->addstr("fax", $self->_form("fax"));
|
|
$self->{"cols"}->addstr("dsc", $self->_form("dsc"));
|
|
$self->{"cols"}->addbool("hid", $self->_form("hid"));
|
|
# Automatic Traditional Chinese to Simplified Chinese conversion
|
|
$self->_zhsync;
|
|
|
|
# Find the changed items
|
|
@additems = qw();
|
|
for ($_ = 0; defined $form->param("cat$_"); $_++) {
|
|
push @additems, $form->param("cat$_")
|
|
if $form->param("cat$_") ne "";
|
|
}
|
|
foreach my $item (@additems) {
|
|
my ($subform, $cols);
|
|
$subform = new CGI("");
|
|
$subform->param("form", "new");
|
|
$subform->param("cat", $item);
|
|
$subform->param("link", $self->{"sn"});
|
|
$cols = new Selima::Processor::LinkCatz($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"}->addstr("title", $self->_form("title"), scalar $cur->param("title"));
|
|
$self->{"cols"}->addstr("title_2ln", $self->_form("title_2ln"), scalar $cur->param("title_2ln"));
|
|
$self->{"cols"}->addurl("url", $self->_form("url"), scalar $cur->param("url"));
|
|
$self->{"cols"}->addstr("email", $self->_form("email"), scalar $cur->param("email"));
|
|
$self->{"cols"}->addurl("icon", $self->_form("icon"), scalar $cur->param("icon"));
|
|
$self->{"cols"}->addstr("addr", $self->_form("addr"), scalar $cur->param("addr"));
|
|
$self->{"cols"}->addstr("tel", $self->_form("tel"), scalar $cur->param("tel"));
|
|
$self->{"cols"}->addstr("fax", $self->_form("fax"), scalar $cur->param("fax"));
|
|
$self->{"cols"}->addstr("dsc", $self->_form("dsc"), scalar $cur->param("dsc"));
|
|
$self->{"cols"}->addbool("hid", $self->_form("hid"), scalar $cur->param("hid"));
|
|
# Automatic Traditional Chinese to Simplified Chinese conversion
|
|
$self->_zhsync;
|
|
|
|
# Find the changed items
|
|
@olditems = qw();
|
|
@newitems = qw();
|
|
for ($_ = 0; $_ < $cur->param("catcount"); $_++) {
|
|
push @olditems, $cur->param("cat$_");
|
|
}
|
|
for ($_ = 0; defined $form->param("cat$_"); $_++) {
|
|
push @newitems, $form->param("cat$_")
|
|
if $form->param("cat$_") ne "";
|
|
}
|
|
%_ = map { $_ => 1 } @newitems;
|
|
@delitems = grep !exists $_{$_}, @olditems;
|
|
%_ = map { $_ => 1 } @olditems;
|
|
@additems = grep !exists $_{$_}, @newitems;
|
|
foreach my $item (@additems) {
|
|
my ($subform, $cols);
|
|
$subform = new CGI("");
|
|
$subform->param("form", "new");
|
|
$subform->param("cat", $item);
|
|
$subform->param("link", $self->{"sn"});
|
|
$cols = new Selima::Processor::LinkCatz($subform);
|
|
$cols->_save_cols;
|
|
push @{$self->{"subs"}}, $cols;
|
|
}
|
|
if (@delitems > 0) {
|
|
my $subform;
|
|
@_ = map "cat=$_", @delitems;
|
|
$_ = (scalar(@_) == 1)? $_[0]: "(" . join(" OR ", @_) . ")";
|
|
$subform = new CGI("");
|
|
$subform->param("cond", "$_ AND link=" . $self->{"sn"});
|
|
push @{$self->{"subs"}}, new Selima::Processor::Deletion($subform, "linkcatz");
|
|
}
|
|
|
|
# A form to delete a current item
|
|
} elsif ($self->{"type"} eq "del") {
|
|
# Find the changed items
|
|
$_ = new CGI("");
|
|
$_->param("cond", "link=" . $self->{"sn"});
|
|
push @{$self->{"subs"}}, new Selima::Processor::Deletion($_, "linkcatz");
|
|
}
|
|
return;
|
|
}
|
|
|
|
# _update_cols: Update the columns
|
|
sub _update_cols : method {
|
|
local ($_, %_);
|
|
my $self;
|
|
($self, @_) = @_;
|
|
$self->{"curshown"} = $self->_shown_parts;
|
|
$self->SUPER::_update_cols(@_);
|
|
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 related link " . $form->param("url")
|
|
. " with s/n " . $self->{"sn"} . "."
|
|
if $self->{"type"} eq "new";
|
|
# A form to edit a current item
|
|
return gactlog "Update the related link " . $form->param("url")
|
|
. " with s/n " . $self->{"sn"} . "."
|
|
if $self->{"type"} eq "cur";
|
|
# A form to delete a current item
|
|
return gactlog "Delete the related link " . $cur->param("url")
|
|
. " 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 related link was not modified."),
|
|
"isform"=>0}
|
|
if !$self->_modified;
|
|
# A form to create a new item
|
|
return {"msg"=>N_("This related link has been successfully added."),
|
|
"isform"=>0}
|
|
if $self->{"type"} eq "new";
|
|
# A form to edit a current item
|
|
return {"msg"=>N_("This related link has been successfully updated."),
|
|
"isform"=>0}
|
|
if $self->{"type"} eq "cur";
|
|
# A form to delete a current item
|
|
return {"msg"=>N_("This related link 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 ($sql, @parents, @cats, @oldcats, @newcats, $cond);
|
|
$self = $_[0];
|
|
($form, $cur) = ($self->{"form"}, $self->{"cur"});
|
|
$self->{"newshown"} = $self->_shown_parts;
|
|
# Remove the unwanted pages
|
|
$self->_remove_curfile;
|
|
|
|
# Find the affected parents
|
|
@parents = qw();
|
|
@_ = qw();
|
|
%_ = map { $_ => 1 } @{${$self->{"curshown"}}{"cats"}};
|
|
push @_, grep !exists $_{$_}, @{${$self->{"newshown"}}{"cats"}};
|
|
%_ = map { $_ => 1 } @{${$self->{"newshown"}}{"cats"}};
|
|
push @_, grep !exists $_{$_}, @{${$self->{"curshown"}}{"cats"}};
|
|
if (@_ > 0) {
|
|
my ($sql, $sth, $count, $row);
|
|
$sql = "SELECT parent FROM linkcat"
|
|
. " WHERE " . join(" OR ", map "sn=$_", @_)
|
|
. " GROUP BY parent;\n";
|
|
$sth = $DBH->prepare($sql);
|
|
$sth->execute;
|
|
$count = $sth->rows;
|
|
for ($_ = 0; $_ < $count; $_++) {
|
|
push @parents, ${$sth->fetch}[0];
|
|
}
|
|
}
|
|
|
|
# Add myself and my parents
|
|
@oldcats = qw();
|
|
@newcats = qw();
|
|
# A form to create a new item
|
|
if ($self->{"type"} eq "new") {
|
|
if (!defined $form->param("hid")) {
|
|
for ($_ = 0; defined $form->param("cat$_"); $_++) {
|
|
push @newcats, $form->param("cat$_")
|
|
if $form->param("cat$_") ne "";
|
|
}
|
|
}
|
|
# A form to edit a current item
|
|
} elsif ($self->{"type"} eq "cur") {
|
|
if (!$cur->param("hid")) {
|
|
for ($_ = 0; $_ < $cur->param("catcount"); $_++) {
|
|
push @oldcats, $cur->param("cat$_");
|
|
}
|
|
}
|
|
if (!defined $form->param("hid")) {
|
|
for ($_ = 0; defined $form->param("cat$_"); $_++) {
|
|
push @newcats, $form->param("cat$_")
|
|
if $form->param("cat$_") ne "";
|
|
}
|
|
}
|
|
# A form to delete a current item
|
|
} elsif ($self->{"type"} eq "del") {
|
|
if (!$cur->param("hid")) {
|
|
for ($_ = 0; $_ < $cur->param("catcount"); $_++) {
|
|
push @oldcats, $cur->param("cat$_");
|
|
}
|
|
}
|
|
}
|
|
@cats = qw();
|
|
%_ = map { $_ => 1 } (@oldcats, @newcats);
|
|
push @cats, keys %_;
|
|
# The statistics pages on their parents are affected
|
|
@_ = qw();
|
|
%_ = map { $_ => 1 } @oldcats;
|
|
push @_, grep !exists $_{$_}, @newcats;
|
|
%_ = map { $_ => 1 } @newcats;
|
|
push @_, grep !exists $_{$_}, @oldcats;
|
|
if (@_ > 0) {
|
|
my ($sql, $sth, $count);
|
|
$_ = join(" OR ", map "sn=$_", @_);
|
|
$_ = "($_)" if @_ > 1;
|
|
$sql = "SELECT parent FROM linkcat"
|
|
. " WHERE $_"
|
|
. " AND parent IS NOT NULL"
|
|
. " AND linkcat_isshown(sn, hid, parent)"
|
|
. " GROUP BY parent;\n";
|
|
$sth = $DBH->prepare($sql);
|
|
$sth->execute;
|
|
$count = $sth->rows;
|
|
for ($_ = 0; $_ < $count; $_++) {
|
|
push @cats, ${$sth->fetch}[0];
|
|
}
|
|
}
|
|
%_ = map { $_ => 1 } @cats;
|
|
@cats = keys %_;
|
|
|
|
# Nothing to rebuild
|
|
return if @cats == 0 && @parents == 0;
|
|
|
|
# Compose the SQL statement
|
|
@_ = qw();
|
|
push @_, "sn=" . $_ foreach @cats;
|
|
foreach (@parents) {
|
|
# The parent page and those share the same parent
|
|
if (defined $_) {
|
|
push @_, "sn=" . $_;
|
|
push @_, "parent=" . $_;
|
|
# The topmost pages
|
|
} else {
|
|
push @_, "parent IS NULL";
|
|
}
|
|
}
|
|
$cond = join " OR ", @_;
|
|
$cond = "($cond)" if @_ > 1;
|
|
@_ = $DBH->cols("linkcat");
|
|
push @_, $DBH->strcat("'/links'", "linkcat_path(sn, id, parent)")
|
|
. " AS path";
|
|
$sql = "SELECT " . join(", ", @_) . " FROM linkcat"
|
|
. " WHERE $cond"
|
|
. " AND linkcat_isshown(sn, hid, parent);\n";
|
|
# Rebuild the pages
|
|
$_ = $MAIN->can("rebuild_links");
|
|
&$_($sql);
|
|
return;
|
|
}
|
|
|
|
# _remove_curfile: Remove the unwanted page
|
|
sub _remove_curfile : method {
|
|
local ($_, %_);
|
|
my $self;
|
|
$self = $_[0];
|
|
# Remove the unwanted category files
|
|
%_ = map { $_ => 1 } @{${$self->{"newshown"}}{"catspath"}};
|
|
grmoldpage $_
|
|
foreach grep !exists $_{$_}, @{${$self->{"curshown"}}{"catspath"}};
|
|
return;
|
|
}
|
|
|
|
# _shown_parts: Obtain the shown parts
|
|
sub _shown_parts : method {
|
|
return links_shown_parts;
|
|
}
|
|
|
|
return 1;
|