parent
4670955cb6
commit
6ae5fe62d7
4 changed files with 64 additions and 1 deletions
|
@ -70,7 +70,8 @@ AM_PL_LOG_FLAGS = -Mstrict -w \
|
||||||
-I'$(abs_top_srcdir)'/t/lib
|
-I'$(abs_top_srcdir)'/t/lib
|
||||||
handwritten_tests = \
|
handwritten_tests = \
|
||||||
t/geturl_connectivity.pl \
|
t/geturl_connectivity.pl \
|
||||||
t/parse_assignments.pl
|
t/parse_assignments.pl \
|
||||||
|
t/write_cache.pl
|
||||||
generated_tests = \
|
generated_tests = \
|
||||||
t/version.pl
|
t/version.pl
|
||||||
TESTS = $(handwritten_tests) $(generated_tests)
|
TESTS = $(handwritten_tests) $(generated_tests)
|
||||||
|
|
|
@ -37,6 +37,8 @@ AC_SUBST([PERL])
|
||||||
# package doesn't depend on all of them, so their availability can't
|
# package doesn't depend on all of them, so their availability can't
|
||||||
# be assumed.
|
# be assumed.
|
||||||
m4_foreach_w([_m], [
|
m4_foreach_w([_m], [
|
||||||
|
File::Basename
|
||||||
|
File::Path
|
||||||
version=0.77
|
version=0.77
|
||||||
], [AX_PROG_PERL_MODULES([_m], [],
|
], [AX_PROG_PERL_MODULES([_m], [],
|
||||||
[AC_MSG_ERROR([missing required Perl module _m])])])
|
[AC_MSG_ERROR([missing required Perl module _m])])])
|
||||||
|
@ -45,6 +47,8 @@ m4_foreach_w([_m], [
|
||||||
# then some tests will fail. Only prints a warning if not installed.
|
# then some tests will fail. Only prints a warning if not installed.
|
||||||
m4_foreach_w([_m], [
|
m4_foreach_w([_m], [
|
||||||
Data::Dumper
|
Data::Dumper
|
||||||
|
File::Spec::Functions
|
||||||
|
File::Temp
|
||||||
Test::More
|
Test::More
|
||||||
], [AX_PROG_PERL_MODULES([_m], [],
|
], [AX_PROG_PERL_MODULES([_m], [],
|
||||||
[AC_MSG_WARN([some tests will fail due to missing module _m])])])
|
[AC_MSG_WARN([some tests will fail due to missing module _m])])])
|
||||||
|
|
12
ddclient.in
12
ddclient.in
|
@ -22,6 +22,8 @@ package ddclient;
|
||||||
require v5.10.1;
|
require v5.10.1;
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
|
use File::Basename;
|
||||||
|
use File::Path qw(make_path);
|
||||||
use Getopt::Long;
|
use Getopt::Long;
|
||||||
use Sys::Hostname;
|
use Sys::Hostname;
|
||||||
use IO::Socket;
|
use IO::Socket;
|
||||||
|
@ -997,6 +999,16 @@ sub write_cache {
|
||||||
|
|
||||||
## write the updates and other entries to the cache file.
|
## write the updates and other entries to the cache file.
|
||||||
if ($file) {
|
if ($file) {
|
||||||
|
(undef, my $dir) = fileparse($file);
|
||||||
|
make_path($dir, { error => \my $err }) if !-d $dir;
|
||||||
|
if ($err && @$err) {
|
||||||
|
for my $diag (@$err) {
|
||||||
|
my ($f, $msg) = %$diag;
|
||||||
|
warning("Failed to create cache file directory: %s: %s", $f, $msg);
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
$saved_cache = undef;
|
$saved_cache = undef;
|
||||||
local *FD;
|
local *FD;
|
||||||
if (!open(FD, "> $file")) {
|
if (!open(FD, "> $file")) {
|
||||||
|
|
46
t/write_cache.pl
Normal file
46
t/write_cache.pl
Normal file
|
@ -0,0 +1,46 @@
|
||||||
|
use Test::More;
|
||||||
|
use File::Spec::Functions;
|
||||||
|
use File::Temp;
|
||||||
|
eval { require Test::MockModule; } or plan(skip_all => $@);
|
||||||
|
SKIP: { eval { require Test::Warnings; } or skip($@, 1); }
|
||||||
|
eval { require 'ddclient'; } or BAIL_OUT($@);
|
||||||
|
|
||||||
|
my $warning;
|
||||||
|
|
||||||
|
my $module = Test::MockModule->new('ddclient');
|
||||||
|
$module->redefine('warning', sub {
|
||||||
|
BAIL_OUT("warning already logged") if defined($warning);
|
||||||
|
$warning = sprintf(shift, @_);
|
||||||
|
});
|
||||||
|
my $tmpdir = File::Temp->newdir();
|
||||||
|
my $dir = $tmpdir->dirname();
|
||||||
|
diag("temporary directory: $dir");
|
||||||
|
|
||||||
|
sub tc {
|
||||||
|
return {
|
||||||
|
name => shift,
|
||||||
|
f => shift,
|
||||||
|
warning_regex => shift,
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
my @test_cases = (
|
||||||
|
tc("create cache file", catfile($dir, 'a', 'b', 'cachefile'), undef),
|
||||||
|
tc("overwrite cache file", catfile($dir, 'a', 'b', 'cachefile'), undef),
|
||||||
|
tc("bad directory", catfile($dir, 'a', 'b', 'cachefile', 'bad'), qr/File exists/),
|
||||||
|
);
|
||||||
|
|
||||||
|
for my $tc (@test_cases) {
|
||||||
|
$warning = undef;
|
||||||
|
ddclient::write_cache($tc->{f});
|
||||||
|
subtest $tc->{name} => sub {
|
||||||
|
if (defined($tc->{warning_regex})) {
|
||||||
|
like($warning, $tc->{warning_regex}, "expected warning message");
|
||||||
|
} else {
|
||||||
|
ok(!defined($warning), "no warning");
|
||||||
|
ok(-f $tc->{f}, "cache file exists");
|
||||||
|
}
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
done_testing();
|
Loading…
Reference in a new issue