# Selima Website Content Management System
# ScptPriv.pm: The script privilege checkers.

#  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-09-28

package Selima::ScptPriv;
use 5.008;
use strict;
use warnings;
use base qw(Exporter);
use vars qw(@EXPORT @EXPORT_OK);
BEGIN {
@EXPORT = qw(is_script_permitted is_admin_script);
@EXPORT_OK = @EXPORT;
# Prototype declaration
sub is_script_permitted(;$);
sub is_admin_script(;$);
}

use Selima::Cache qw(:scptpriv);
use Selima::ChkPriv;
use Selima::DataVars qw($DBH :requri);
use Selima::Guest;
use Selima::LogIn;

# is_script_permitted: Check the script privilege
sub is_script_permitted(;$) {
    local ($_, %_);
    my ($script, $sth, $sql, $count);
    $script = $_[0];
    # Default to the current script
    $script = $REQUEST_PATH if !defined $script;
    
    # Return the cache
    return $ScptPriv_is_script_permitted{$script}
        if exists $ScptPriv_is_script_permitted{$script};
    
    # Always true for super users
    return ($ScptPriv_is_script_permitted{$script} = 1) if is_su();
    
    # Obtain the permitted groups
    $sql = "SELECT groups.id AS grp FROM scptpriv"
        . " INNER JOIN groups ON scptpriv.grp=groups.sn"
        . " WHERE scptpriv.script=" . $DBH->quote($script) . ";\n";
    $sth = $DBH->prepare($sql);
    $sth->execute;
    $count = $sth->rows;
    for ($_ = 0, @_ = qw(); $_ < $count; $_++) {
        push @_, ${$sth->fetch}[0];
    }
    
    # Only true for guests to act like ordinary administrators
    return ($ScptPriv_is_script_permitted{$script} = 1)
        if is_guest && scalar(@_) > 0;
    
    # Obtain the belonged groups
    %_ = map { $_ => 1 } @_;
    @_ = get_login_groups;
    # If there is any intersection
    foreach (@_) {
        return ($ScptPriv_is_script_permitted{$script} = 1)
            if exists $_{$_};
    }
    
    # Default to false
    return ($ScptPriv_is_script_permitted{$script} = 0);
}

# is_admin_script: If this is an administrative script
sub is_admin_script(;$) {
    local ($_, %_);
    my $script;
    $script = $_[0];
    # Default to the current script
    $script = $REQUEST_PATH if !defined $script;
    # Return the cache
    return $ScptPriv_is_admin_script{$script}
        if exists $ScptPriv_is_admin_script{$script};
    # Check the "/magicat/" or "/admin/" prefix
    return ($ScptPriv_is_admin_script{$script} =
        $script =~ /^\/(?:magicat|admin)\//);
}

return 1;