Merge pull request #681 from rhansen/group_hosts_by
group_hosts_by: Add IPv6 and undef/unset support
This commit is contained in:
commit
a0e119c2f2
4 changed files with 107 additions and 14 deletions
|
@ -65,6 +65,7 @@ handwritten_tests = \
|
|||
t/builtinfw_query.pl \
|
||||
t/get_ip_from_if.pl \
|
||||
t/geturl_connectivity.pl \
|
||||
t/group_hosts_by.pl \
|
||||
t/interval_expired.pl \
|
||||
t/is-and-extract-ipv4.pl \
|
||||
t/is-and-extract-ipv6.pl \
|
||||
|
|
|
@ -49,6 +49,7 @@ AC_SUBST([PERL])
|
|||
# package doesn't depend on all of them, so their availability can't
|
||||
# be assumed.
|
||||
m4_foreach_w([_m], [
|
||||
Data::Dumper
|
||||
File::Basename
|
||||
File::Path
|
||||
File::Temp
|
||||
|
@ -63,7 +64,6 @@ m4_foreach_w([_m], [
|
|||
# then some tests will fail. Only prints a warning if not installed.
|
||||
m4_foreach_w([_m], [
|
||||
B
|
||||
Data::Dumper
|
||||
File::Spec::Functions
|
||||
File::Temp
|
||||
], [AX_PROG_PERL_MODULES([_m], [],
|
||||
|
|
28
ddclient.in
28
ddclient.in
|
@ -15,6 +15,7 @@ package ddclient;
|
|||
require v5.10.1;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Data::Dumper;
|
||||
use File::Basename;
|
||||
use File::Path qw(make_path);
|
||||
use File::Temp;
|
||||
|
@ -3421,13 +3422,14 @@ sub get_ipv6 {
|
|||
## group_hosts_by
|
||||
######################################################################
|
||||
sub group_hosts_by {
|
||||
##TODO - Update for wantipv4 and wantipv6
|
||||
my ($hosts, $attributes) = @_;
|
||||
my %attrs = (map({ ($_ => 1) } @$attributes), 'wantip' => 1);
|
||||
my %attrs = map({ ($_ => 1) } @$attributes);
|
||||
my @attrs = sort(keys(%attrs));
|
||||
my %groups = ();
|
||||
my $d = Data::Dumper->new([])->Indent(0)->Sortkeys(1)->Terse(1)->Useqq(1);
|
||||
for my $h (@$hosts) {
|
||||
my $sig = join(',', map({ sprintf("%s=%s", $_, $config{$h}{$_} // '') } @attrs));
|
||||
my %cfg = map({ ($_ => $config{$h}{$_}); } grep(exists($config{$h}{$_}), @attrs));
|
||||
my $sig = $d->Reset()->Values([\%cfg])->Dump();
|
||||
push @{$groups{$sig}}, $h;
|
||||
}
|
||||
return %groups;
|
||||
|
@ -3980,7 +3982,7 @@ sub nic_dyndns2_update {
|
|||
debug("\nnic_dyndns2_update -------------------");
|
||||
|
||||
## group hosts with identical attributes together
|
||||
my %groups = group_hosts_by([ @_ ], [ qw(login password server static custom wildcard mx backupmx) ]);
|
||||
my %groups = group_hosts_by(\@_, [qw(login password server static custom wildcard mx backupmx wantipv4 wantipv6)]);
|
||||
|
||||
my %errors = (
|
||||
'badauth' => 'Bad authorization (username or password)',
|
||||
|
@ -4275,7 +4277,7 @@ sub nic_noip_update {
|
|||
debug("\nnic_noip_update -------------------");
|
||||
|
||||
## group hosts with identical attributes together
|
||||
my %groups = group_hosts_by([ @_ ], [ qw(login password server static custom wildcard mx backupmx) ]);
|
||||
my %groups = group_hosts_by(\@_, [qw(login password server static custom wildcard mx backupmx wantipv4 wantipv6)]);
|
||||
|
||||
my %errors = (
|
||||
'badauth' => 'Invalid username or password',
|
||||
|
@ -4622,7 +4624,7 @@ sub nic_zoneedit1_update {
|
|||
debug("\nnic_zoneedit1_update -------------------");
|
||||
|
||||
## group hosts with identical attributes together
|
||||
my %groups = group_hosts_by([ @_ ], [ qw(login password server zone) ]);
|
||||
my %groups = group_hosts_by(\@_, [qw(login password server zone wantip)]);
|
||||
|
||||
## update each set of hosts that had similar configurations
|
||||
for my $sig (keys %groups) {
|
||||
|
@ -5709,7 +5711,7 @@ sub nic_godaddy_update {
|
|||
debug("\nnic_godaddy_update --------------------");
|
||||
|
||||
## group hosts with identical attributes together
|
||||
my %groups = group_hosts_by([ @_ ], [ qw(server login password zone) ]);
|
||||
my %groups = group_hosts_by(\@_, [qw(server login password zone wantipv4 wantipv6)]);
|
||||
|
||||
## update each set of hosts that had similar configurations
|
||||
for my $sig (keys %groups) {
|
||||
|
@ -5846,7 +5848,7 @@ sub nic_googledomains_update {
|
|||
debug("\nnic_googledomains_update -------------------");
|
||||
|
||||
## group hosts with identical attributes together
|
||||
my %groups = group_hosts_by([ @_ ], [ qw(server login password) ]);
|
||||
my %groups = group_hosts_by(\@_, [qw(server login password wantip)]);
|
||||
|
||||
## update each set of hosts that had similar configurations
|
||||
for my $sig (keys %groups) {
|
||||
|
@ -6026,7 +6028,7 @@ sub nic_nsupdate_update {
|
|||
debug("\nnic_nsupdate_update -------------------");
|
||||
|
||||
## group hosts with identical attributes together
|
||||
my %groups = group_hosts_by([ @_ ], [ qw(login password server zone) ]);
|
||||
my %groups = group_hosts_by(\@_, [qw(login password server zone wantipv4 wantipv6)]);
|
||||
|
||||
## update each set of hosts that had similar configurations
|
||||
for my $sig (keys %groups) {
|
||||
|
@ -6143,7 +6145,7 @@ sub nic_cloudflare_update {
|
|||
debug("\nnic_cloudflare_update -------------------");
|
||||
|
||||
## group hosts with identical attributes together
|
||||
my %groups = group_hosts_by([ @_ ], [ qw(ssh login password server wildcard mx backupmx zone) ]);
|
||||
my %groups = group_hosts_by(\@_, [qw(ssh login password server wildcard mx backupmx zone wantipv4 wantipv6)]);
|
||||
|
||||
## update each set of hosts that had similar configurations
|
||||
for my $sig (keys %groups) {
|
||||
|
@ -6291,7 +6293,7 @@ sub nic_hetzner_update {
|
|||
debug("\nnic_hetzner_update -------------------");
|
||||
|
||||
## group hosts with identical attributes together
|
||||
my %groups = group_hosts_by([ @_ ], [ qw(ssh login password server wildcard mx backupmx zone) ]);
|
||||
my %groups = group_hosts_by(\@_, [qw(ssh login password server wildcard mx backupmx zone wantipv4 wantipv6)]);
|
||||
|
||||
## update each set of hosts that had similar configurations
|
||||
for my $sig (keys %groups) {
|
||||
|
@ -6448,7 +6450,7 @@ sub nic_yandex_update {
|
|||
debug("\nnic_yandex_update -------------------");
|
||||
|
||||
## group hosts with identical attributes together
|
||||
my %groups = group_hosts_by([ @_ ], [ qw(server login pasword) ]);
|
||||
my %groups = group_hosts_by(\@_, [qw(server login pasword wantip)]);
|
||||
|
||||
## update each set of hosts that had similar configurations
|
||||
for my $sig (keys %groups) {
|
||||
|
@ -7339,7 +7341,7 @@ EoEXAMPLE
|
|||
}
|
||||
|
||||
sub nic_cloudns_update {
|
||||
my %groups = group_hosts_by([ @_ ], [ qw(dynurl) ]);
|
||||
my %groups = group_hosts_by(\@_, [qw(dynurl wantip)]);
|
||||
for my $hr (values(%groups)) {
|
||||
my @hosts = @$hr;
|
||||
my $hosts = join(',', @hosts);
|
||||
|
|
90
t/group_hosts_by.pl
Normal file
90
t/group_hosts_by.pl
Normal file
|
@ -0,0 +1,90 @@
|
|||
use Test::More;
|
||||
SKIP: { eval { require Test::Warnings; } or skip($@, 1); }
|
||||
eval { require 'ddclient'; } or BAIL_OUT($@);
|
||||
eval { require Data::Dumper; } or skip($@, 1);
|
||||
Data::Dumper->import();
|
||||
|
||||
my $h1 = 'h1';
|
||||
my $h2 = 'h2';
|
||||
my $h3 = 'h3';
|
||||
|
||||
$ddclient::config{$h1} = {
|
||||
common => 'common',
|
||||
h1h2 => 'h1 and h2',
|
||||
unique => 'h1',
|
||||
falsy => 0,
|
||||
maybeunset => 'unique',
|
||||
};
|
||||
$ddclient::config{$h2} = {
|
||||
common => 'common',
|
||||
h1h2 => 'h1 and h2',
|
||||
unique => 'h2',
|
||||
falsy => '',
|
||||
maybeunset => undef, # should not be grouped with unset
|
||||
};
|
||||
$ddclient::config{$h3} = {
|
||||
common => 'common',
|
||||
h1h2 => 'unique',
|
||||
unique => 'h3',
|
||||
falsy => undef,
|
||||
# maybeunset is intentionally not set
|
||||
};
|
||||
|
||||
my @test_cases = (
|
||||
{
|
||||
desc => 'empty attribute set yields single group with all hosts',
|
||||
groupby => [qw()],
|
||||
want => [[$h1, $h2, $h3]],
|
||||
},
|
||||
{
|
||||
desc => 'common attribute yields single group with all hosts',
|
||||
groupby => [qw(common)],
|
||||
want => [[$h1, $h2, $h3]],
|
||||
},
|
||||
{
|
||||
desc => 'subset share a value',
|
||||
groupby => [qw(h1h2)],
|
||||
want => [[$h1, $h2], [$h3]],
|
||||
},
|
||||
{
|
||||
desc => 'all unique',
|
||||
groupby => [qw(unique)],
|
||||
want => [[$h1], [$h2], [$h3]],
|
||||
},
|
||||
{
|
||||
desc => 'combination',
|
||||
groupby => [qw(common h1h2)],
|
||||
want => [[$h1, $h2], [$h3]],
|
||||
},
|
||||
{
|
||||
desc => 'falsy values',
|
||||
groupby => [qw(falsy)],
|
||||
want => [[$h1], [$h2], [$h3]],
|
||||
},
|
||||
{
|
||||
desc => 'set, unset, undef',
|
||||
groupby => [qw(maybeunset)],
|
||||
want => [[$h1], [$h2], [$h3]],
|
||||
},
|
||||
{
|
||||
desc => 'missing attribute',
|
||||
groupby => [qw(thisdoesnotexist)],
|
||||
want => [[$h1, $h2, $h3]],
|
||||
},
|
||||
);
|
||||
|
||||
for my $tc (@test_cases) {
|
||||
my %got = ddclient::group_hosts_by([$h1, $h2, $h3], $tc->{groupby});
|
||||
# %got is used as a set of sets. Sort everything to make comparison easier.
|
||||
my @got = sort({
|
||||
for (my $i = 0; $i < @$a && $i < @$b; ++$i) {
|
||||
my $x = $a->[$i] cmp $b->[$i];
|
||||
return $x if $x != 0;
|
||||
}
|
||||
return @$a <=> @$b;
|
||||
} map({ [sort(@$_)]; } values(%got)));
|
||||
is_deeply(\@got, $tc->{want}, $tc->{desc})
|
||||
or diag(Data::Dumper->Dump([\@got, $tc->{want}], [qw(got want)]));
|
||||
}
|
||||
|
||||
done_testing();
|
Loading…
Reference in a new issue