From 37504fe6f2697a588c7ab7fd2ee9f0b61373fc29 Mon Sep 17 00:00:00 2001 From: Richard Hansen Date: Fri, 2 Aug 2024 04:29:45 -0400 Subject: [PATCH 1/9] Logger: Document the `log` method --- ddclient.in | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/ddclient.in b/ddclient.in index 71befaf..04c9157 100755 --- a/ddclient.in +++ b/ddclient.in @@ -2361,15 +2361,24 @@ sub ynu { defined($self->{ctx}) ? ($self->{ctx}) : ()); } + # Takes the following keyword arguments: + # * `msg` (string): The message to log. + # * `label` (string): Severity ('DEBUG', 'WARNING', etc.) to prefix each line with. + # * `fh` (file handle): Where to write the log messages. + # * `email` (boolean): Whether to include the message in the next email. + # * `raw` (boolean): Whether to omit `label` and the contexts (output `msg` as-is). + # * `ctx` (optional string): If defined, this is temporarily pushed onto the context stack + # (for this call only). + # + # The keyword arguments may optionally be followed by a single positional argument, which + # becomes the value for the `msg` keyword argument if the `msg` keyword argument is not + # provided (it is ignored if the `msg` keyword is present). sub log { my $self = shift; my %args = ( msg => '', label => '', fh => *STDERR, - email => 0, # If truthy, the message is also included in the next email. - raw => 0, # If truthy, label and contexts are not included. - ctx => undef, # If defined, temporarily push this onto the context stack. (@_ % 2) ? (msg => pop) : (), @_, ); From dff4cd48540ccd52ae1abb29b1563baea78f2db6 Mon Sep 17 00:00:00 2001 From: Richard Hansen Date: Fri, 2 Aug 2024 04:39:31 -0400 Subject: [PATCH 2/9] Logger: Localize override in test --- t/logmsg.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/t/logmsg.pl b/t/logmsg.pl index ede234a..ea69f17 100644 --- a/t/logmsg.pl +++ b/t/logmsg.pl @@ -113,7 +113,7 @@ for my $tc (@test_cases) { $tc->{wantemail} //= ''; my $output; open(my $fh, '>', \$output); - $ddclient::emailbody = $tc->{init_email} // ''; + local $ddclient::emailbody = $tc->{init_email} // ''; local $ddclient::_l = $ddclient::_l; $ddclient::_l = ddclient::pushlogctx($_) for @{$tc->{ctxs} // []}; ddclient::logmsg(fh => $fh, @{$tc->{args}}); From 439b0fd0e1b90a9edafef91502fbb901048f0390 Mon Sep 17 00:00:00 2001 From: Richard Hansen Date: Fri, 2 Aug 2024 16:29:21 -0400 Subject: [PATCH 3/9] Logger: Minimize STDERR override in tests --- t/logmsg.pl | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/t/logmsg.pl b/t/logmsg.pl index ea69f17..334bda1 100644 --- a/t/logmsg.pl +++ b/t/logmsg.pl @@ -149,10 +149,12 @@ my @logfmt_test_cases = ( for my $tc (@logfmt_test_cases) { my $got; open(my $fh, '>', \$got); - local *STDERR = $fh; local $ddclient::globals{debug} = 1; %ddclient::globals if 0; - ddclient::debug(@{$tc->{args}}); + { + local *STDERR = $fh; + ddclient::debug(@{$tc->{args}}); + } close($fh); is($got, $tc->{want}, $tc->{desc}); } From f36c2f45aacd9eec87d9a3d7968cdeca58e254c4 Mon Sep 17 00:00:00 2001 From: Richard Hansen Date: Fri, 2 Aug 2024 04:36:59 -0400 Subject: [PATCH 4/9] Logger: Always use STDERR as output filehandle There's no good reason for the caller of the `log` method to control the output filehandle. --- ddclient.in | 4 +--- t/logmsg.pl | 22 ++++------------------ 2 files changed, 5 insertions(+), 21 deletions(-) diff --git a/ddclient.in b/ddclient.in index 04c9157..e3a762a 100755 --- a/ddclient.in +++ b/ddclient.in @@ -2364,7 +2364,6 @@ sub ynu { # Takes the following keyword arguments: # * `msg` (string): The message to log. # * `label` (string): Severity ('DEBUG', 'WARNING', etc.) to prefix each line with. - # * `fh` (file handle): Where to write the log messages. # * `email` (boolean): Whether to include the message in the next email. # * `raw` (boolean): Whether to omit `label` and the contexts (output `msg` as-is). # * `ctx` (optional string): If defined, this is temporarily pushed onto the context stack @@ -2378,7 +2377,6 @@ sub ynu { my %args = ( msg => '', label => '', - fh => *STDERR, (@_ % 2) ? (msg => pop) : (), @_, ); @@ -2393,7 +2391,7 @@ sub ynu { $buffer =~ s/\n/\n$prefix/g; } $buffer .= "\n"; - print({$args{fh}} $buffer); + print(STDERR $buffer); if ($args{email}) { $emailbody .= $buffer; diff --git a/t/logmsg.pl b/t/logmsg.pl index 334bda1..f91adc0 100644 --- a/t/logmsg.pl +++ b/t/logmsg.pl @@ -2,23 +2,6 @@ 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', @@ -116,7 +99,10 @@ for my $tc (@test_cases) { local $ddclient::emailbody = $tc->{init_email} // ''; local $ddclient::_l = $ddclient::_l; $ddclient::_l = ddclient::pushlogctx($_) for @{$tc->{ctxs} // []}; - ddclient::logmsg(fh => $fh, @{$tc->{args}}); + { + local *STDERR = $fh; + ddclient::logmsg(@{$tc->{args}}); + } close($fh); is($output, $tc->{want}, 'output text matches'); is($ddclient::emailbody, $tc->{want_email} // '', 'email content matches'); From 15db76f73968a99445a1fe349d63522c040b5dcd Mon Sep 17 00:00:00 2001 From: Richard Hansen Date: Fri, 2 Aug 2024 15:37:41 -0400 Subject: [PATCH 5/9] Logger: Accept an arrayref of contexts for `ctx` parameter --- ddclient.in | 11 ++++++----- t/logmsg.pl | 21 ++++++++++++++++++++- 2 files changed, 26 insertions(+), 6 deletions(-) diff --git a/ddclient.in b/ddclient.in index e3a762a..ccd67f3 100755 --- a/ddclient.in +++ b/ddclient.in @@ -2352,13 +2352,13 @@ sub ynu { sub new { my ($class, $ctx, $parent) = @_; + $ctx = [$ctx // ()] if ref($ctx) eq ''; return bless({ctx => $ctx, parent => $parent, _in_logger => 0}, $class); } sub _ctxs { my ($self) = @_; - return ($self->{parent} ? $self->{parent}->_ctxs() : (), - defined($self->{ctx}) ? ($self->{ctx}) : ()); + return ($self->{parent} ? $self->{parent}->_ctxs() : (), @{$self->{ctx}}); } # Takes the following keyword arguments: @@ -2366,8 +2366,8 @@ sub ynu { # * `label` (string): Severity ('DEBUG', 'WARNING', etc.) to prefix each line with. # * `email` (boolean): Whether to include the message in the next email. # * `raw` (boolean): Whether to omit `label` and the contexts (output `msg` as-is). - # * `ctx` (optional string): If defined, this is temporarily pushed onto the context stack - # (for this call only). + # * `ctx` (optional string or arrayref of strings): Context or contexts to temporarily push + # onto the context stack (for this call only). # # The keyword arguments may optionally be followed by a single positional argument, which # becomes the value for the `msg` keyword argument if the `msg` keyword argument is not @@ -2380,11 +2380,12 @@ sub ynu { (@_ % 2) ? (msg => pop) : (), @_, ); + $args{ctx} = [$args{ctx} // ()] if ref($args{ctx}) eq ''; my $buffer = $args{msg}; chomp($buffer); if (!$args{raw}) { my $prefix = $args{label} ? sprintf("%-8s ", $args{label} . ':') : ''; - $prefix .= join('', map("[$_]", $self->_ctxs(), $args{ctx} // ())); + $prefix .= "[$_]" for $self->_ctxs(), @{$args{ctx}}; $prefix .= '> ' if $prefix; $buffer = "$prefix$buffer"; $prefix =~ s/> $/ /; diff --git a/t/logmsg.pl b/t/logmsg.pl index f91adc0..6db4b2e 100644 --- a/t/logmsg.pl +++ b/t/logmsg.pl @@ -83,12 +83,31 @@ my @test_cases = ( "LBL: [context one][context two] bar\n"), }, { - desc => 'ctx arg', + desc => 'string ctx arg', args => [label => 'LBL', ctx => 'three', "foo\nbar"], ctxs => ['one', 'two'], want => ("LBL: [one][two][three]> foo\n" . "LBL: [one][two][three] bar\n"), }, + { + desc => 'arrayref ctx arg', + args => [label => 'LBL', ctx => ['three', 'four'], "foo\nbar"], + ctxs => ['one', 'two'], + want => ("LBL: [one][two][three][four]> foo\n" . + "LBL: [one][two][three][four] bar\n"), + }, + { + desc => 'undef ctx', + args => [label => 'LBL', "foo"], + ctxs => ['one', undef], + want => "LBL: [one]> foo\n", + }, + { + desc => 'arrayref ctx', + args => [label => 'LBL', "foo"], + ctxs => ['one', ['two', 'three']], + want => "LBL: [one][two][three]> foo\n", + }, ); for my $tc (@test_cases) { From 0f094ac121afb67fe737d2c279d2bf9e3d4d1c26 Mon Sep 17 00:00:00 2001 From: Richard Hansen Date: Fri, 2 Aug 2024 18:15:29 -0400 Subject: [PATCH 6/9] Logger: Check `msg` and `label` for definedness --- ddclient.in | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/ddclient.in b/ddclient.in index ccd67f3..f5aed3b 100755 --- a/ddclient.in +++ b/ddclient.in @@ -2374,16 +2374,12 @@ sub ynu { # provided (it is ignored if the `msg` keyword is present). sub log { my $self = shift; - my %args = ( - msg => '', - label => '', - (@_ % 2) ? (msg => pop) : (), - @_, - ); + my %args = (@_ % 2 ? (msg => pop) : (), @_); $args{ctx} = [$args{ctx} // ()] if ref($args{ctx}) eq ''; - my $buffer = $args{msg}; + my $buffer = $args{msg} // ''; chomp($buffer); if (!$args{raw}) { + $args{label} //= ''; my $prefix = $args{label} ? sprintf("%-8s ", $args{label} . ':') : ''; $prefix .= "[$_]" for $self->_ctxs(), @{$args{ctx}}; $prefix .= '> ' if $prefix; From 56f8c83d3a4bbb86d4d9e09dae7b890d1d9fbf0f Mon Sep 17 00:00:00 2001 From: Richard Hansen Date: Fri, 2 Aug 2024 18:41:05 -0400 Subject: [PATCH 7/9] Logger: Check `label` for emptiness, not truthiness --- ddclient.in | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ddclient.in b/ddclient.in index f5aed3b..77e5cf6 100755 --- a/ddclient.in +++ b/ddclient.in @@ -2380,7 +2380,7 @@ sub ynu { chomp($buffer); if (!$args{raw}) { $args{label} //= ''; - my $prefix = $args{label} ? sprintf("%-8s ", $args{label} . ':') : ''; + my $prefix = $args{label} ne '' ? sprintf("%-8s ", $args{label} . ':') : ''; $prefix .= "[$_]" for $self->_ctxs(), @{$args{ctx}}; $prefix .= '> ' if $prefix; $buffer = "$prefix$buffer"; From f4248d06171f71f2f7fb42439e6783ebc64fbcb7 Mon Sep 17 00:00:00 2001 From: Richard Hansen Date: Fri, 2 Aug 2024 18:47:12 -0400 Subject: [PATCH 8/9] Logger: Separate implementation from interface This makes it easier to override the implementation for testing purposes. --- ddclient.in | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/ddclient.in b/ddclient.in index 77e5cf6..d39d80a 100755 --- a/ddclient.in +++ b/ddclient.in @@ -2376,12 +2376,17 @@ sub ynu { my $self = shift; my %args = (@_ % 2 ? (msg => pop) : (), @_); $args{ctx} = [$args{ctx} // ()] if ref($args{ctx}) eq ''; - my $buffer = $args{msg} // ''; + return $self->_log(\%args); + } + + sub _log { + my ($self, $args) = @_; + my $buffer = $args->{msg} // ''; chomp($buffer); - if (!$args{raw}) { - $args{label} //= ''; - my $prefix = $args{label} ne '' ? sprintf("%-8s ", $args{label} . ':') : ''; - $prefix .= "[$_]" for $self->_ctxs(), @{$args{ctx}}; + if (!$args->{raw}) { + $args->{label} //= ''; + my $prefix = $args->{label} ne '' ? sprintf("%-8s ", $args->{label} . ':') : ''; + $prefix .= "[$_]" for $self->_ctxs(), @{$args->{ctx}}; $prefix .= '> ' if $prefix; $buffer = "$prefix$buffer"; $prefix =~ s/> $/ /; @@ -2390,7 +2395,7 @@ sub ynu { $buffer .= "\n"; print(STDERR $buffer); - if ($args{email}) { + if ($args->{email}) { $emailbody .= $buffer; if (!$self->{_in_logger}) { ++$self->{_in_logger}; # Avoid infinite recursion if logger itself logs. From 43ea691e0ca40de0082f8eec24aa935cecd49b27 Mon Sep 17 00:00:00 2001 From: Richard Hansen Date: Fri, 2 Aug 2024 15:46:53 -0400 Subject: [PATCH 9/9] Logger: Move log output to parentmost Logger This makes it possible for tests to redirect log output so that they can ensure that certain log messages are generated. --- ddclient.in | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/ddclient.in b/ddclient.in index d39d80a..cc637a5 100755 --- a/ddclient.in +++ b/ddclient.in @@ -2356,11 +2356,6 @@ sub ynu { return bless({ctx => $ctx, parent => $parent, _in_logger => 0}, $class); } - sub _ctxs { - my ($self) = @_; - return ($self->{parent} ? $self->{parent}->_ctxs() : (), @{$self->{ctx}}); - } - # Takes the following keyword arguments: # * `msg` (string): The message to log. # * `label` (string): Severity ('DEBUG', 'WARNING', etc.) to prefix each line with. @@ -2381,12 +2376,16 @@ sub ynu { sub _log { my ($self, $args) = @_; + # A new arrayref is created instead of unshifting into @{$args->{ctx}} to avoid mutating + # the caller's arrayref (in case it is reused in a future call). + $args->{ctx} = [@{$self->{ctx}}, @{$args->{ctx}}]; + return $self->{parent}->_log($args) if defined($self->{parent}); my $buffer = $args->{msg} // ''; chomp($buffer); if (!$args->{raw}) { $args->{label} //= ''; my $prefix = $args->{label} ne '' ? sprintf("%-8s ", $args->{label} . ':') : ''; - $prefix .= "[$_]" for $self->_ctxs(), @{$args->{ctx}}; + $prefix .= "[$_]" for @{$args->{ctx}}; $prefix .= '> ' if $prefix; $buffer = "$prefix$buffer"; $prefix =~ s/> $/ /;