logmsg: New low-level logging interface

This commit is contained in:
Richard Hansen 2024-05-22 01:54:31 -04:00
parent f9dafa35a1
commit 065b227711
3 changed files with 150 additions and 27 deletions

View file

@ -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 \

View file

@ -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
View 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();