Initial commit.

lib/perl5/Selima/Array.pm

@@ -0,0 +1,84 @@
+# Selima Website Content Management System
+# Array.pm: The array-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-09-12
+
+package Selima::Array;
+use 5.008;
+use strict;
+use warnings;
+use base qw(Exporter);
+use vars qw(@EXPORT @EXPORT_OK);
+BEGIN {
+@EXPORT = qw(in_array keys_ml keys_nl);
+@EXPORT_OK = @EXPORT;
+# Prototype declaration
+sub in_array($@);
+sub keys_ml(\%);
+sub keys_nl(\%);
+}
+
+use Selima::DataVars qw(:lninfo);
+use Selima::GetLang;
+
+# in_array: If something is in an array
+sub in_array($@) {
+    local ($_, %_);
+    my ($item, @array);
+    ($item, @array) = @_;
+    %_ = map { $_ => 1 } @array;
+    return exists $_{$item};
+}
+
+# keys_ml: Return a list of multi-lingual keys in a hash
+sub keys_ml(\%) {
+    local ($_, %_);
+    my ($hash, $lndb);
+    $hash = $_[0];
+    $lndb = getlang LN_DATABASE;
+    @_ = qw();
+    foreach (keys %$hash) {
+        # it has a language suffix
+        push @_, $_ if s/_$lndb$//;
+    }
+    return @_;
+}
+
+# keys_nl: Return a list of keys without their multi-lingual in a hash
+sub keys_nl(\%) {
+    local ($_, %_);
+    my ($hash, %mlkeys);
+    $hash = $_[0];
+    %mlkeys = map { $_ => 1 } keys_ml %$hash;
+    %_ = qw();
+    foreach (keys %$hash) {
+        # No suffix
+        if (!/^(.+)_[^_]+$/) {
+            $_{$_} = 1;
+        # The prefix is one of the language columns
+        } elsif (exists $mlkeys{$1}) {
+            $_{$1} = 1;
+        # An ordinary prefix
+        } else {
+            $_{$_} = 1;
+        }
+    }
+    return keys %_;
+}
+
+return 1;