85 lines
2.1 KiB
Perl
85 lines
2.1 KiB
Perl
# 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;
|