365 lines
11 KiB
Perl
365 lines
11 KiB
Perl
# Selima Website Content Management System
|
|
# Links.pm: The related-link 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-10-24
|
|
|
|
package Selima::Links;
|
|
use 5.008;
|
|
use strict;
|
|
use warnings;
|
|
use base qw(Exporter);
|
|
use vars qw(@EXPORT @EXPORT_OK);
|
|
BEGIN {
|
|
@EXPORT = qw();
|
|
push @EXPORT, qw(linkcat_title linkcat_options link_title);
|
|
push @EXPORT, qw(links_shown_parts link_tree link_tree_full);
|
|
@EXPORT_OK = @EXPORT;
|
|
# Prototype declaration
|
|
sub linkcat_title($);
|
|
sub linkcat_options($);
|
|
sub link_title($);
|
|
sub links_shown_parts();
|
|
sub link_tree($$;$);
|
|
sub link_tree_full($;$);
|
|
sub link_subtree($$$;$);
|
|
}
|
|
|
|
use Encode qw(decode);
|
|
|
|
use Selima::Cache qw(:links);
|
|
use Selima::ChkFunc;
|
|
use Selima::CommText;
|
|
use Selima::DataVars qw($DBH :l10n :lninfo);
|
|
use Selima::EchoForm;
|
|
use Selima::GetLang;
|
|
use Selima::LnInfo;
|
|
use Selima::PageFunc;
|
|
use Selima::ShortCut;
|
|
|
|
# linkcat_title: Obtain a link category title
|
|
sub linkcat_title($) {
|
|
local ($_, %_);
|
|
my ($sn, $sql, $sth, $col, $thiscol, $lang, $defcol);
|
|
$sn = $_[0];
|
|
# Bounce if there is any problem with $sn
|
|
return t_notset if !defined $sn;
|
|
# Return the cache
|
|
return $Links_linkcat_title{$sn} if exists $Links_linkcat_title{$sn};
|
|
|
|
# Check the serial number first
|
|
return ($Links_linkcat_title{$sn} = t_na)
|
|
if !check_sn $sn;
|
|
|
|
# Query
|
|
# Unilingual
|
|
if (@ALL_LINGUAS == 1) {
|
|
$col = "linkcat_fulltitle(parent, title) AS title";
|
|
# Multilingual
|
|
} else {
|
|
$thiscol = "title_" . getlang LN_DATABASE;
|
|
$lang = getlang;
|
|
# Default language
|
|
if ($lang eq $DEFAULT_LANG) {
|
|
$col = "linkcat_fulltitle('$lang', parent, $thiscol) AS title";
|
|
# Fall back to the default language
|
|
} else {
|
|
$defcol = "title_" . ln($DEFAULT_LANG, LN_DATABASE);
|
|
$col = "linkcat_fulltitle('$lang', parent, COALESCE($thiscol, $defcol)) AS title";
|
|
}
|
|
}
|
|
$sql = "SELECT $col FROM linkcat WHERE sn=$sn;\n";
|
|
$sth = $DBH->prepare($sql);
|
|
$sth->execute;
|
|
|
|
# Not found
|
|
return ($Links_linkcat_title{$sn} = t_na)
|
|
unless $sth->rows == 1;
|
|
|
|
# Found
|
|
return ($Links_linkcat_title{$sn} = ${$sth->fetch}[0]);
|
|
}
|
|
|
|
# linkcat_options: Obtain a link category options list
|
|
sub linkcat_options($) {
|
|
local ($_, %_);
|
|
my ($value, $sql, $thiscol, $defcol, $lang, $content);
|
|
$value = $_[0];
|
|
|
|
# Unilingual
|
|
if (@ALL_LINGUAS == 1) {
|
|
$content = "linkcat_fulltitle(parent, title) AS content";
|
|
# Multilingual
|
|
} else {
|
|
$thiscol = "title_" . getlang(LN_DATABASE);
|
|
$lang = getlang;
|
|
# Default language
|
|
if ($lang eq $DEFAULT_LANG) {
|
|
$content = "linkcat_fulltitle('$lang', parent, $thiscol) AS content";
|
|
# Fall back to the default language
|
|
} else {
|
|
$defcol = "title_" . ln($DEFAULT_LANG, LN_DATABASE);
|
|
$content = "linkcat_fulltitle('$lang', parent, COALESCE($thiscol, $defcol)) AS content";
|
|
}
|
|
}
|
|
$sql = "SELECT sn AS value, $content FROM linkcat"
|
|
. " ORDER BY linkcat_fullord(parent, ord);\n";
|
|
return opt_list $sql, $value;
|
|
}
|
|
|
|
# link_title: Obtain a link title
|
|
sub link_title($) {
|
|
local ($_, %_);
|
|
my ($sn, $sql, $sth, $thiscol, $defcol);
|
|
$sn = $_[0];
|
|
# Bounce if there is any problem with $sn
|
|
return t_notset if !defined $sn;
|
|
# Return the cache
|
|
return $Links_link_title{$sn} if exists $Links_link_title{$sn};
|
|
|
|
# Check the serial number first
|
|
return ($Links_link_title{$sn} = t_na)
|
|
if !check_sn $sn;
|
|
|
|
# Query
|
|
$sql = "SELECT title FROM links WHERE sn=$sn;\n";
|
|
$sth = $DBH->prepare($sql);
|
|
$sth->execute;
|
|
|
|
# Not found
|
|
return ($Links_link_title{$sn} = t_na)
|
|
unless $sth->rows == 1;
|
|
|
|
# Found
|
|
return ($Links_link_title{$sn} = ${$sth->fetch}[0]);
|
|
}
|
|
|
|
# link_url: Obtain a link URL
|
|
sub link_url($) {
|
|
local ($_, %_);
|
|
my ($sn, $sql, $sth, $thiscol, $defcol);
|
|
$sn = $_[0];
|
|
# Bounce if there is any problem with $sn
|
|
return t_notset if !defined $sn;
|
|
# Return the cache
|
|
return $Links_link_title{$sn} if exists $Links_link_title{$sn};
|
|
|
|
# Check the serial number first
|
|
return ($Links_link_title{$sn} = t_na)
|
|
if !check_sn $sn;
|
|
|
|
# Query
|
|
$sql = "SELECT url FROM links WHERE sn=$sn;\n";
|
|
$sth = $DBH->prepare($sql);
|
|
$sth->execute;
|
|
|
|
# Not found
|
|
return ($Links_link_title{$sn} = t_na)
|
|
unless $sth->rows == 1;
|
|
|
|
# Found
|
|
return ($Links_link_title{$sn} = ${$sth->fetch}[0]);
|
|
}
|
|
|
|
# links_shown_parts: Obtain the shown links parts
|
|
sub links_shown_parts() {
|
|
local ($_, %_);
|
|
my ($sql, $sth, $count, $row, $path);
|
|
|
|
%_ = (
|
|
"cats" => [],
|
|
"catspath" => [],
|
|
);
|
|
|
|
# Obtain the shown categories
|
|
$path = $DBH->strcat("'/links'", "linkcat_path(sn, id, parent)")
|
|
. " AS path";
|
|
$sql = "SELECT sn, $path FROM linkcat"
|
|
. " WHERE linkcat_isshown(sn, hid, parent)"
|
|
. " ORDER BY linkcat_fullord(parent, ord);\n";
|
|
$sth = $DBH->prepare($sql);
|
|
$sth->execute;
|
|
$count = $sth->rows;
|
|
for ($_ = 0; $_ < $count; $_++) {
|
|
$row = $sth->fetchrow_hashref;
|
|
push @{$_{"cats"}}, $$row{"sn"};
|
|
push @{$_{"catspath"}}, $$row{"path"};
|
|
}
|
|
@{$_{"cats"}} = sort @{$_{"cats"}};
|
|
@{$_{"catspath"}} = sort @{$_{"catspath"}};
|
|
|
|
return \%_;
|
|
}
|
|
|
|
|
|
####################
|
|
# Subroutines about link categories
|
|
####################
|
|
# link_tree: Get the page tree of the links
|
|
sub link_tree($$;$) {
|
|
local ($_, %_);
|
|
my ($path, $lang, $preview, $dir, $tree);
|
|
($path, $lang, $preview) = @_;
|
|
# Obtain the directory
|
|
$dir = $path;
|
|
$dir =~ s/[^\/]+\/?$//;
|
|
|
|
# Initialize the directory array
|
|
$Links_link_tree{$lang} = {}
|
|
if !exists $Links_link_tree{$lang};
|
|
# Return the cache
|
|
return ${$Links_link_tree{$lang}}{$dir}
|
|
if exists ${$Links_link_tree{$lang}}{$dir};
|
|
|
|
# Get the full page tree of the links
|
|
$tree = link_tree_full $lang, $preview;
|
|
# Make a hash of the page tree
|
|
$Links_link_tree{$lang} = {hash_tree $tree};
|
|
|
|
# Not found
|
|
return undef if !exists ${$Links_link_tree{$lang}}{$dir};
|
|
return ${$Links_link_tree{$lang}}{$dir};
|
|
}
|
|
|
|
# link_tree_full: Get the page tree of the links
|
|
sub link_tree_full($;$) {
|
|
local ($_, %_);
|
|
my ($lang, $preview, $charset, $tree, $pages);
|
|
($lang, $preview) = @_;
|
|
# Return the cache
|
|
return $Links_link_tree_full{$lang}
|
|
if exists $Links_link_tree_full{$lang};
|
|
|
|
# Set the language
|
|
$charset = ln($lang, LN_CHARSET);
|
|
|
|
# Initialize the result
|
|
$tree = qw();
|
|
|
|
# Set the index page
|
|
$$tree{"index"} = {
|
|
"path" => "/links/",
|
|
"title" => C_("Related Links"),
|
|
};
|
|
|
|
# Get the link categories
|
|
$pages = link_subtree "/links", undef, $lang, $preview;
|
|
$$tree{"pages"} = $pages if defined $pages;
|
|
|
|
return $tree;
|
|
}
|
|
|
|
# link_subtree: Get the page subtree of the links
|
|
sub link_subtree($$$;$) {
|
|
local ($_, %_);
|
|
my ($path, $parent, $lang, $preview);
|
|
my ($lndb, $lndbdef, $has_links, $pages);
|
|
my ($sql, $sth, $count, @cols, @conds);
|
|
($path, $parent, $lang, $preview) = @_;
|
|
|
|
# Check if there is any link below this category
|
|
$has_links = 0;
|
|
if (defined $parent) {
|
|
$sql = "SELECT links.sn FROM links"
|
|
. " INNER JOIN linkcatz ON linkcatz.link=links.sn"
|
|
. " WHERE linkcatz.cat=" . $parent
|
|
. " AND NOT links.hid;\n";
|
|
$sth = $DBH->prepare($sql);
|
|
$sth->execute;
|
|
$has_links = ($sth->rows > 0);
|
|
# Check the preview
|
|
$has_links = in_array($parent, @{$$preview{"cats"}})
|
|
if !$has_links && defined $preview;
|
|
}
|
|
|
|
# Obtain the subcategories
|
|
@cols = qw();
|
|
push @cols, "sn AS sn";
|
|
push @cols, "id AS id";
|
|
# Unilingual
|
|
if (@ALL_LINGUAS == 1) {
|
|
push @cols, "title AS title";
|
|
# Multilingual
|
|
} else {
|
|
# Set the language
|
|
$lndb = ln $lang, LN_DATABASE;
|
|
if ($lang eq $DEFAULT_LANG) {
|
|
push @cols, "title_$lndb AS title";
|
|
} else {
|
|
$lndbdef = ln $DEFAULT_LANG, LN_DATABASE;
|
|
push @cols, "COALESCE(title_$lndb, title_$lndbdef)"
|
|
. " AS title";
|
|
}
|
|
}
|
|
push @cols, "ord AS ord";
|
|
@conds = qw();
|
|
if (!defined $parent) {
|
|
push @conds, "parent IS NULL";
|
|
} else {
|
|
push @conds, "parent=$parent";
|
|
}
|
|
push @conds, "NOT hid";
|
|
push @conds, "sn!=" . $$preview{"sn"}
|
|
if defined $preview && exists $$preview{"sn"};
|
|
$sql = "SELECT " . join(", ", @cols) . " FROM linkcat"
|
|
. " WHERE " . join(" AND ", @conds)
|
|
. " ORDER BY ord;\n";
|
|
$sth = $DBH->prepare($sql);
|
|
$sth->execute;
|
|
$count = $sth->rows;
|
|
for ($_ = 0, $pages = []; $_ < $count; $_++) {
|
|
my ($row, $subpages, $subpath);
|
|
$row = $sth->fetchrow_hashref;
|
|
$subpages = link_subtree($path . "/" . $$row{"id"},
|
|
$$row{"sn"}, $lang, $preview);
|
|
# Only create subtree that has some content
|
|
if (defined $subpages) {
|
|
# No subcategories -- create it as a ".html" page
|
|
if (@$subpages == 0) {
|
|
$subpath = $path . "/" . $$row{"id"} . ".html";
|
|
push @$pages, {
|
|
"path" => $subpath,
|
|
"title" => $$row{"title"},
|
|
"ord" => $$row{"ord"},
|
|
};
|
|
# There are subcatgories -- create it as a directory
|
|
} else {
|
|
$subpath = $path . "/" . $$row{"id"} . "/";
|
|
push @$pages, {
|
|
"path" => $subpath,
|
|
"title" => $$row{"title"},
|
|
"ord" => $$row{"ord"},
|
|
"sub" => {
|
|
"index" => {
|
|
"path" => $subpath,
|
|
"title" => $$row{"title"},
|
|
},
|
|
"pages" => $subpages,
|
|
},
|
|
};
|
|
}
|
|
}
|
|
}
|
|
|
|
# No content below
|
|
return undef if !$has_links && @$pages == 0;
|
|
|
|
return $pages;
|
|
}
|
|
|
|
return 1;
|