# 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;