171 lines
4.9 KiB
Perl
Executable File
171 lines
4.9 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
# ------------------------------------------------------------------------------
|
|
# (C) Crown copyright Met Office. All rights reserved.
|
|
# For further details please refer to the file COPYRIGHT.txt
|
|
# which you should have received as part of this distribution.
|
|
# ------------------------------------------------------------------------------
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Fcm::CfgLine;
|
|
use Fcm::Config;
|
|
use Scalar::Util qw{reftype};
|
|
use Test::More (tests => 90);
|
|
|
|
BEGIN: {
|
|
use_ok('Fcm::ConfigSystem');
|
|
}
|
|
|
|
my $CONFIG = undef;
|
|
|
|
# ------------------------------------------------------------------------------
|
|
if (!caller()) {
|
|
main(@ARGV);
|
|
}
|
|
|
|
# ------------------------------------------------------------------------------
|
|
sub main {
|
|
local @ARGV = @_;
|
|
test_compare_setting_in_config();
|
|
}
|
|
|
|
# ------------------------------------------------------------------------------
|
|
# Tests "compare_setting_in_config".
|
|
sub test_compare_setting_in_config {
|
|
my $PREFIX = 'TEST';
|
|
my %S = (egg => [qw{boiled poached}], ham => 'roasted', bacon => 'fried');
|
|
my %S_MOD = (ham => 'boiled');
|
|
my %S_MOD_ARRAY = (egg => [qw{scrambled omelette}]);
|
|
my %S_ADD = (mushroom => 'sauteed');
|
|
my %S_DEL = (bacon => undef);
|
|
|
|
my @ITEMS = (
|
|
{
|
|
name => 'empty',
|
|
original => {},
|
|
added => {},
|
|
removed => {},
|
|
modified => {},
|
|
},
|
|
{
|
|
name => 'add keys to empty',
|
|
original => {},
|
|
added => {%S},
|
|
removed => {},
|
|
modified => {%S},
|
|
},
|
|
{
|
|
name => 'remove all',
|
|
original => {%S},
|
|
added => {},
|
|
removed => {},
|
|
modified => {map {($_, undef)} keys(%S)},
|
|
},
|
|
{
|
|
name => 'no change',
|
|
original => {%S},
|
|
added => {%S},
|
|
removed => {},
|
|
modified => {},
|
|
},
|
|
{
|
|
name => 'modify key',
|
|
original => {%S},
|
|
added => {%S, %S_MOD},
|
|
removed => {},
|
|
modified => {%S_MOD},
|
|
},
|
|
{
|
|
name => 'modify an array key',
|
|
original => {%S},
|
|
added => {%S, %S_MOD_ARRAY},
|
|
removed => {},
|
|
modified => {%S_MOD_ARRAY},
|
|
},
|
|
{
|
|
name => 'add a key',
|
|
original => {%S},
|
|
added => {%S, %S_ADD},
|
|
removed => {},
|
|
modified => {%S_ADD},
|
|
},
|
|
{
|
|
name => 'delete a key',
|
|
original => {%S},
|
|
added => {%S},
|
|
removed => {%S_DEL},
|
|
modified => {%S_DEL},
|
|
},
|
|
{
|
|
name => 'modify a key and delete a key',
|
|
original => {%S},
|
|
added => {%S, %S_MOD},
|
|
removed => {%S_DEL},
|
|
modified => {%S_MOD, %S_DEL},
|
|
},
|
|
{
|
|
name => 'add a key and delete a key',
|
|
original => {%S},
|
|
added => {%S, %S_ADD},
|
|
removed => {%S_DEL},
|
|
modified => {%S_ADD, %S_DEL},
|
|
},
|
|
);
|
|
|
|
# A naive function to serialise an array reference
|
|
my $flatten = sub {
|
|
if (ref($_[0]) && reftype($_[0]) eq 'ARRAY') {
|
|
join(q{ }, sort(@{$_[0]}))
|
|
}
|
|
else {
|
|
$_[0];
|
|
}
|
|
};
|
|
|
|
my $CONFIG = Fcm::Config->instance();
|
|
for my $item (@ITEMS) {
|
|
# New settings
|
|
$CONFIG->{setting}{$PREFIX} = {%{$item->{added}}};
|
|
for my $key (keys(%{$item->{removed}})) {
|
|
delete($CONFIG->{setting}{$PREFIX}{$key});
|
|
}
|
|
|
|
# Old lines
|
|
my @old_lines = map {
|
|
Fcm::CfgLine->new(
|
|
LABEL => $PREFIX . $Fcm::Config::DELIMITER . $_,
|
|
VALUE => $flatten->($item->{original}{$_}),
|
|
)
|
|
} keys(%{$item->{original}});
|
|
|
|
# Invokes the method
|
|
my $system = Fcm::ConfigSystem->new();
|
|
my ($changed_hash_ref, $new_cfg_lines_ref)
|
|
= $system->compare_setting_in_config($PREFIX, \@old_lines);
|
|
|
|
# Tests the return values
|
|
my $T = $item->{name};
|
|
is_deeply(
|
|
$changed_hash_ref, $item->{modified},
|
|
"$T: \$changed_hash_ref content",
|
|
);
|
|
is(
|
|
scalar(@{$new_cfg_lines_ref}),
|
|
scalar(keys(%{$item->{added}})) - scalar(keys(%{$item->{removed}})),
|
|
"$T: \$new_cfg_lines_ref length",
|
|
);
|
|
for my $line (@{$new_cfg_lines_ref}) {
|
|
my $key = $line->label_from_field(1);
|
|
ok(exists($item->{added}{$key}), "$T: expected label $key");
|
|
ok(!exists($item->{removed}{$key}), "$T: unexpected label $key");
|
|
is(
|
|
$line->value(), $flatten->($item->{added}{$key}),
|
|
"$T: line content $key",
|
|
);
|
|
}
|
|
}
|
|
}
|
|
|
|
__END__
|