# Selima Website Content Management System
# PageFunc.pm: The web page 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-15

package Selima::PageFunc;
use 5.008;
use strict;
use warnings;
use base qw(Exporter);
use vars qw(@EXPORT @EXPORT_OK);
BEGIN {
@EXPORT = qw(page_param page_all_linguas hash_tree outpage rebuildtype_options);
@EXPORT_OK = @EXPORT;
# Prototype declaration
sub page_param(;$);
sub page_all_linguas($);
sub hash_tree($);
sub outpage($$;$);
sub rebuildtype_options($);
}

use Config qw(%Config);
use Devel::Symdump;
use File::Basename qw(basename dirname);

use Selima::AbsURI;
use Selima::DataVars qw($DBH :dataman :l10n :lninfo :output :rebuild :requri :scptconf);
use Selima::EchoForm;
use Selima::GetLang;
use Selima::Guest;
use Selima::LnInfo;
use Selima::MkAllDir;
use Selima::Page2Rel;
use Selima::ScptPriv;
use Selima::ShortCut;
use Selima::Unicode;
use Selima::XFileIO;

# page_param: Gather page parameters
sub page_param(;$) {
    local ($_, %_);
    my $args;
    $args = $_[0];
    # Default to an empty array
    $args = {} if !defined $args;
    return $args if exists $$args{".fixed"};
    
    # Obtain page parameters
    $args = {%$ALT_PAGE_PARAM, %$args} if defined $ALT_PAGE_PARAM;
    $args = {%$PAGE_PARAM, %$args} if defined $PAGE_PARAM;
    
    # Set the path
    $$args{"path"} = $REQUEST_PATH
        if !exists $$args{"path"};
    # Set the language
    $$args{"lang"} = getlang
        if !exists $$args{"lang"};
    # Set if static or not
    $$args{"static"} = 0
        if !exists $$args{"static"};
    # Set if show a pretty result or not
    $$args{"clean"} = 0
        if !exists $$args{"clean"};
    # Set if this page is administrative
    $$args{"admin"} = is_admin_script $$args{"path"}
        if !exists $$args{"admin"};
    # Set if this is a preview page or not
    $$args{"preview"} = undef
        if !exists $$args{"preview"};
    # Set if we shoud show the tite in html_header() or not
    $$args{"no_auto_title"} = 0
        if !exists $$args{"no_auto_title"};
    # Set all the available languages
    $$args{"all_linguas"} = [@ALL_LINGUAS]
        if !exists $$args{"all_linguas"};
    # Set the language of the title
    $$args{"title_lang"} = $$args{"lang"}
        if !exists $$args{"title_lang"};
    # The upper level index page
    if (!exists $$args{"up"}) {
        if ($$args{"path"} !~ /\/(?:errors|picdesc)\//) {
            $$args{"up"} = $$args{"path"};
            $$args{"up"} =~ s/[^\/]+\/?$//;
            # Remove the /cgi-bin/ directory
            $$args{"up"} =~ s/\/cgi-(?:bin|perl|raw)\/$/\//;
        }
    }
    
    # Load the local extension when available
    $args = &$_($args) if   defined $MAIN
                            && defined $MAIN->can("page_param_site");
    $args = &$_($args) if   defined $MAIN
                            && defined $MAIN->can("page_param_script");
    
    # Tag that we have fixed it
    $$args{".fixed"} = 1;
    return $args;
}

# page_all_linguas: Get the available languages for this page
sub page_all_linguas($) {
    local ($_, %_);
    my ($page, $lndb);
    $page = $_[0];
    
    # It is specified
    return @{$$page{"all_linguas"}}
        if exists $$page{"all_linguas"};
    
    # Preview
    if (exists $$page{"preview"} && $$page{"preview"}) {
        my ($sql, $sth, $count, $row);
        # Uni-lingual
        return (getlang) unless $DBH->is_ml_table($THIS_TABLE);
        # Find the page
        return (getlang) unless exists $$page{"sn"};
        $sql = "SELECT * FROM $THIS_TABLE"
            . " WHERE sn=" . $$page{"sn"} . ";\n";
        $sth = $DBH->prepare($sql);
        $sth->execute;
        # If this record exist
        return (getlang) if $sth->rows == 0;
        $row = $sth->fetchrow_hashref;
        # Check each language
        @_ = qw();
        foreach my $lang (@ALL_LINGUAS) {
            $lndb = ln $lang, LN_DATABASE;
            # Add it if the page for this language exists
            push @_, $lang if   defined $$row{"title_$lndb"}
                                || $lang eq getlang;
        }
        return @_;
    }
    
    # $page is uni-lingual
    return (getlang) if exists $$page{"title"};
    
    # $page is multi-lingual
    # Check each language
    @_ = qw();
    foreach my $lang (@ALL_LINGUAS) {
        $lndb = ln $lang, LN_DATABASE;
        # Skip if the page for this language does not exist
        push @_, $lang if defined $$page{"title_$lndb"};
    }
    return @_;
}

# hash_tree: Make a hash of the page tree
sub hash_tree($) {
    local ($_, %_);
    my ($tree, %hash);
    $tree = $_[0];
    # The index page
    $hash{${$$tree{"index"}}{"path"}} = $tree
        if exists $$tree{"index"};
    # Track the subdirectories
    if (exists $$tree{"pages"}) {
        for ($_ = 0; $_ < @{$$tree{"pages"}}; $_++) {
            # A subdirectory exists
            if (exists ${${$$tree{"pages"}}[$_]}{"sub"}) {
                %hash = (%hash,
                    hash_tree ${${$$tree{"pages"}}[$_]}{"sub"});
            }
        }
    }
    return %hash;
}

# outpage: Output a page
sub outpage($$;$) {
    local ($_, %_);
    my ($html, $path, $lang, $file);
    ($html, $path, $lang) = @_;
    $lang = getlang if !defined $lang;
    
    # Convert the URLs to relative
    if ($path =~ /^\/errors\//) {
        $html = page2abs $html, $path;
        $html =~ s/href="\/errors\/(\$url)"/href="$1"/g;
        $html =~ s/href="$path(#.+?)"/href="$1"/g;
    } else {
        $html = page2rel $html, $path;
    }
    # Encode the e-mail at-signs (@)
    $html =~ s/@/&#64;/g;
    # Decode the e-mail at-signs (@) of spamtrap
    $html =~ s/spamtrap&#64;/spamtrap@/g;
    # Encode the page to the target character set
    $html = page_encode($html, ln($lang, LN_CHARSET));
    # Obtain the real file name
    $file = $DOC_ROOT . $path;
    $file .= "index.html" if $file =~ /\/$/;
    $file .= "." . ln($lang, LN_FILENAME) if @ALL_LINGUAS > 1;
    # Create the necessary directories
    mkalldir dirname($file);
    # Write the file
    xfupdate_template "$file.xhtml", $html;
    # Make the symbolic link for the text/html
    if (defined $Config{"d_symlink"}) {
        my ($targfile, $linkfile);
        ($targfile, $linkfile) = (basename("$file.xhtml"), "$file.html");
        unless (-l $linkfile && readlink $linkfile eq $targfile) {
            unlink $linkfile if -l $linkfile;
            symlink $targfile, $linkfile;
        }
    }
    
    return;
}

# rebuildtype_options: Obtain a rebuild type options list
sub rebuildtype_options($) {
    local ($_, %_);
    my $value;
    $value = $_[0];
    # The type labels
    %_ = (
        "pages" => C_("Web pages"),
        "news"  => C_("News"),
        "links" => C_("Related links"),
        "home"  => C_("Home page"),
        "all"   => C_("Whole web site"),
        map { $_ => __($REBUILD_LABELS{$_}) } keys %REBUILD_LABELS,
    );
    
    # Get the available rebuild types
    @_ = map {
            "value"     => $_,
            "content"   => (exists $_{$_}? $_{$_}: $_),
        }, sort grep s/^.+::rebuild_([^:]+)$/$1/,
            Devel::Symdump->new($MAIN)->functions;
    # Obtain the HTML
    $_ = opt_list_array @_;
    
    return preselect_options($_, $value);
}

return 1;