Initial commit.
This commit is contained in:
364
lib/perl5/Selima/Links.pm
Normal file
364
lib/perl5/Selima/Links.pm
Normal file
@@ -0,0 +1,364 @@
|
||||
# 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;
|
||||
Reference in New Issue
Block a user