# 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;