Initial commit.

lib/perl5/Selima/ChkWrite.pm

@@ -0,0 +1,80 @@
+# 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;