logmsg: New low-level logging interface
This commit is contained in:
parent
f9dafa35a1
commit
065b227711
3 changed files with 150 additions and 27 deletions
|
@ -68,6 +68,7 @@ handwritten_tests = \
|
|||
t/is-and-extract-ipv4.pl \
|
||||
t/is-and-extract-ipv6.pl \
|
||||
t/is-and-extract-ipv6-global.pl \
|
||||
t/logmsg.pl \
|
||||
t/parse_assignments.pl \
|
||||
t/skip.pl \
|
||||
t/ssl-validate.pl \
|
||||
|
|
55
ddclient.in
55
ddclient.in
|
@ -125,7 +125,7 @@ if ($program =~ /test/i) {
|
|||
$savedir = 'URL';
|
||||
}
|
||||
|
||||
my $emailbody = '';
|
||||
our $emailbody = '';
|
||||
my $last_emailbody = '';
|
||||
|
||||
## If run as *d (e.g., ddclientd) then daemonize by default (but allow
|
||||
|
@ -2382,20 +2382,22 @@ sub ynu {
|
|||
return $undef;
|
||||
}
|
||||
######################################################################
|
||||
## msg
|
||||
## debug
|
||||
## warning
|
||||
## fatal
|
||||
## Logging
|
||||
######################################################################
|
||||
my $_in_msg = 0;
|
||||
sub _msg {
|
||||
my $fh = shift;
|
||||
my $email = shift;
|
||||
my $prefix = shift;
|
||||
my $format = shift;
|
||||
my $buffer = sprintf $format, @_;
|
||||
my $_in_logmsg = 0;
|
||||
sub logmsg {
|
||||
my %args = (
|
||||
msg => '',
|
||||
pfx => '',
|
||||
fh => *STDERR,
|
||||
email => 0, # If truthy, the message is also included in the next email.
|
||||
(@_ % 2) ? (msg => pop) : (),
|
||||
@_,
|
||||
);
|
||||
my $buffer = $args{msg};
|
||||
chomp($buffer);
|
||||
|
||||
my $prefix = $args{pfx};
|
||||
$prefix = sprintf "%-9s ", $prefix if $prefix;
|
||||
if ($file) {
|
||||
$prefix .= "file $file";
|
||||
|
@ -2407,27 +2409,26 @@ sub _msg {
|
|||
$buffer =~ s/\n/\n$prefix/g;
|
||||
}
|
||||
$buffer .= "\n";
|
||||
print $fh $buffer;
|
||||
print({$args{fh}} $buffer);
|
||||
|
||||
if ($email) {
|
||||
if ($args{email}) {
|
||||
$emailbody .= $buffer;
|
||||
if (!$_in_msg) {
|
||||
++$_in_msg; # avoid infinite recursion if logger calls _msg
|
||||
if (!$_in_logmsg) {
|
||||
++$_in_logmsg; # avoid infinite recursion if logger calls logmsg
|
||||
logger($buffer);
|
||||
--$_in_msg;
|
||||
--$_in_logmsg;
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
sub msg { _msg(*STDOUT, 0, '', @_); }
|
||||
sub verbose { _msg(*STDOUT, 1, @_) if opt('verbose'); }
|
||||
sub info { _msg(*STDOUT, 1, 'INFO:', @_) if opt('verbose'); }
|
||||
sub debug { _msg(*STDOUT, 0, 'DEBUG:', @_) if opt('debug'); }
|
||||
sub debug2 { _msg(*STDOUT, 0, 'DEBUG:', @_) if opt('debug') && opt('verbose'); }
|
||||
sub warning { _msg(*STDERR, 1, 'WARNING:', @_); }
|
||||
sub fatal { _msg(*STDERR, 1, 'FATAL:', @_); sendmail(); exit(1); }
|
||||
sub success { _msg(*STDOUT, 1, 'SUCCESS:', @_); }
|
||||
sub failed { _msg(*STDERR, 1, 'FAILED:', @_); $result = 'FAILED'; }
|
||||
sub msg { logmsg(fh => *STDOUT, sprintf(shift, @_)); }
|
||||
sub verbose { logmsg(fh => *STDOUT, email => 1, pfx => pop, sprintf(shift, @_)) if opt('verbose'); }
|
||||
sub info { logmsg(fh => *STDOUT, email => 1, pfx => 'INFO:', sprintf(shift, @_)) if opt('verbose'); }
|
||||
sub debug { logmsg(fh => *STDOUT, pfx => 'DEBUG:', sprintf(shift, @_)) if opt('debug'); }
|
||||
sub debug2 { logmsg(fh => *STDOUT, pfx => 'DEBUG:', sprintf(shift, @_)) if opt('debug') && opt('verbose'); }
|
||||
sub warning { logmsg( email => 1, pfx => 'WARNING:', sprintf(shift, @_)); }
|
||||
sub fatal { logmsg( email => 1, pfx => 'FATAL:', sprintf(shift, @_)); sendmail(); exit(1); }
|
||||
sub success { logmsg(fh => *STDOUT, email => 1, pfx => 'SUCCESS:', sprintf(shift, @_)); }
|
||||
sub failed { logmsg( email => 1, pfx => 'FAILED:', sprintf(shift, @_)); $result = 'FAILED'; }
|
||||
sub prettytime { return scalar(localtime(shift)); }
|
||||
|
||||
sub prettyinterval {
|
||||
|
|
121
t/logmsg.pl
Normal file
121
t/logmsg.pl
Normal file
|
@ -0,0 +1,121 @@
|
|||
use Test::More;
|
||||
SKIP: { eval { require Test::Warnings; } or skip($@, 1); }
|
||||
eval { require 'ddclient'; } or BAIL_OUT($@);
|
||||
|
||||
{
|
||||
my $output;
|
||||
open(my $fh, '>', \$output);
|
||||
local *STDERR = $fh;
|
||||
ddclient::logmsg('to STDERR');
|
||||
close($fh);
|
||||
is($output, "to STDERR\n", 'logs to STDERR by default');
|
||||
}
|
||||
|
||||
{
|
||||
my $output;
|
||||
open(my $fh, '>', \$output);
|
||||
ddclient::logmsg(fh => $fh, 'to file handle');
|
||||
close($fh);
|
||||
is($output, "to file handle\n", 'logs to provided file handle');
|
||||
}
|
||||
|
||||
my @test_cases = (
|
||||
{
|
||||
desc => 'adds a newline',
|
||||
args => ['xyz'],
|
||||
want => "xyz\n",
|
||||
},
|
||||
{
|
||||
desc => 'removes one trailing newline (before adding a newline)',
|
||||
args => ["xyz \n\t\n\n"],
|
||||
want => "xyz \n\t\n\n",
|
||||
},
|
||||
{
|
||||
desc => 'accepts msg keyword parameter',
|
||||
args => [msg => 'xyz'],
|
||||
want => "xyz\n",
|
||||
},
|
||||
{
|
||||
desc => 'msg keyword parameter trumps message parameter',
|
||||
args => [msg => 'kw', 'pos'],
|
||||
want => "kw\n",
|
||||
},
|
||||
{
|
||||
desc => 'msg keyword parameter trumps message parameter',
|
||||
args => [msg => 'kw', 'pos'],
|
||||
want => "kw\n",
|
||||
},
|
||||
{
|
||||
desc => 'email appends to email body',
|
||||
args => [email => 1, 'foo'],
|
||||
init_email => "preexisting message\n",
|
||||
want_email => "preexisting message\nfoo\n",
|
||||
want => "foo\n",
|
||||
},
|
||||
{
|
||||
desc => 'single-line prefix',
|
||||
args => [pfx => 'PFX:', 'foo'],
|
||||
want => "PFX: foo\n",
|
||||
},
|
||||
{
|
||||
desc => 'multi-line prefix',
|
||||
args => [pfx => 'PFX:', "foo\nbar"],
|
||||
want => "PFX: foo\nPFX: bar\n",
|
||||
},
|
||||
{
|
||||
desc => 'single-line long prefix',
|
||||
args => [pfx => 'VERY LONG PREFIX:', 'foo'],
|
||||
want => "VERY LONG PREFIX: foo\n",
|
||||
},
|
||||
{
|
||||
desc => 'multi-line long prefix',
|
||||
args => [pfx => 'VERY LONG PREFIX:', "foo\nbar"],
|
||||
want => "VERY LONG PREFIX: foo\nVERY LONG PREFIX: bar\n",
|
||||
},
|
||||
{
|
||||
desc => 'single line, no prefix, file',
|
||||
args => ['foo'],
|
||||
file => 'name',
|
||||
want => "file name: foo\n",
|
||||
},
|
||||
{
|
||||
desc => 'single line, no prefix, file, and line number',
|
||||
args => ['foo'],
|
||||
file => 'name',
|
||||
lineno => 42,
|
||||
want => "file name, line 42: foo\n",
|
||||
},
|
||||
{
|
||||
desc => 'single line, prefix, file, and line number',
|
||||
args => [pfx => 'PFX:', 'foo'],
|
||||
file => 'name',
|
||||
lineno => 42,
|
||||
want => "PFX: file name, line 42: foo\n",
|
||||
},
|
||||
{
|
||||
desc => 'multiple lines, prefix, file, and line number',
|
||||
args => [pfx => 'PFX:', "foo\nbar"],
|
||||
file => 'name',
|
||||
lineno => 42,
|
||||
want => "PFX: file name, line 42: foo\nPFX: file name, line 42: bar\n",
|
||||
},
|
||||
);
|
||||
|
||||
for my $tc (@test_cases) {
|
||||
subtest $tc->{desc} => sub {
|
||||
$tc->{wantemail} //= '';
|
||||
my $output;
|
||||
open(my $fh, '>', \$output);
|
||||
$ddclient::emailbody = $tc->{init_email} // '';
|
||||
local $ddclient::file = $tc->{file} // '';
|
||||
$ddclient::file if 0; # suppress spurious warning "Name used only once: possible typo"
|
||||
local $ddclient::lineno = $tc->{lineno} // '';
|
||||
$ddclient::lineno if 0; # suppress spurious warning "Name used only once: possible typo"
|
||||
ddclient::logmsg(fh => $fh, @{$tc->{args}});
|
||||
close($fh);
|
||||
is($output, $tc->{want}, 'output text matches');
|
||||
is($ddclient::emailbody, $tc->{want_email} // '', 'email content matches');
|
||||
}
|
||||
}
|
||||
|
||||
done_testing();
|
Loading…
Reference in a new issue