# Selima Website Content Management System
# ChkWrite.pm: The write-permission checker.

#  Copyright (c) 2005-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: 2005-02-28

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

use File::Basename qw(dirname);

use Selima::ShortCut;

# check_writable: Check the permission to write to a file.
#   Input: File full pathname $file.
#   Output: true if success, false if failed.
sub check_writable($) {
    local ($_, %_);
    my ($file, $parent);
    $file = $_[0];
    # Standardize it
    # File exists.
    if (-e $file) {
        # If it is a file
        return {"msg"=>N_("[_1]: It is not a file."),
                "margs"=>[$file]}
            if !-f $file;
        # If it is writable
        return {"msg"=>N_("[_1]: You have no permission to overwrite this file."),
                "margs"=>[$file]}
            if !-w $file;
    
    # Not an existing file.  See if we can create it.
    } else {
        $parent = $file;
        # Find the nearest existing parent
        $parent = dirname($parent)
            while $parent ne "" && !-e $parent;
        # Creat files from root --- You are insane
        return {"msg"=>N_("[_1]: You cannot create anything under the root directory."),
                "margs"=>[$file]}
            if $parent eq "";
        # This parent is not a directory
        return {"msg"=>N_("[_1]: One of the parents of this file ([_2]) is not a directory.  You cannot create any new file inside."),
                "margs"=>[$file, $parent]}
            if !-d $parent;
        # If it is possible to create entries in this directory
        return {"msg"=>N_("[_1]: You have no permission to create any file under [_2]."),
                "margs"=>[$file, $parent]}
            if !-w $parent;
    }
    # OK
    return;
}

return 1;