logging: New Logger class to generally handle context prefixes

ddclient.in

@@ -128,8 +128,9 @@ my $last_emailbody = '';
 ## flags and options to override).
 my $daemon_default = ($programd =~ /d$/) ? interval('5m') : undef;
 
-our $file = '';
+# Current Logger instance.  To push a context prefix onto the context stack:
-our $lineno = '';
+#    local _l = pushlogctx('additional context goes here');
+our $_l = ddclient::Logger->new();
 
 $ENV{'PATH'} = (exists($ENV{PATH}) ? "$ENV{PATH}:" : "") . "/sbin:/usr/sbin:/bin:/usr/bin:/etc:/usr/lib:";
 
@@ -1679,10 +1680,8 @@ sub _read_config {
     #     accumulated thus far and stored in $1->{$host} for each
     #     referenced host.
 
-    my $config  = shift;
+    my ($config, $globals, $stamp, $file) = @_;
-    my $globals = shift;
+    local $_l = pushlogctx("file $file");
-    my $stamp   = shift;
-    local $file = shift;
     my %globals = ();
     my %config  = ();
     my $content = '';
@@ -1710,13 +1709,14 @@ sub _read_config {
         warning("file $file must not be accessible by others.");
     }
 
-    local $lineno = 0;
+    my $lineno = 0;
     my $continuation = '';
     my %passwords    = ();
     while (<FD>) {
         s/[\r\n]//g;
 
         $lineno++;
+        local $_l = $_l->{parent}; $_l = pushlogctx("file $file, line $lineno");
 
         ## check for the program version stamp
         if (($. == 1) && $stamp && ($_ !~ /^$stamp$/i)) {
@@ -2344,28 +2344,38 @@ sub ynu {
 ######################################################################
 ## Logging
 ######################################################################
-my $_in_logmsg = 0;
+{
-sub logmsg {
+    package ddclient::Logger;
+
+    sub new {
+        my ($class, $ctx, $parent) = @_;
+        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}) : ());
+    }
+
+    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) : (),
             @_,
         );
         my $buffer = $args{msg};
         chomp($buffer);
-
+        if (!$args{raw}) {
-    my $prefix = $args{label};
+            my $prefix = $args{label} ? sprintf("%-8s ", $args{label} . ':') : '';
-    $prefix = sprintf("%-8s ", $prefix . ':') if $prefix;
+            $prefix .= join('', map("[$_]", $self->_ctxs(), $args{ctx} // ()));
-    if ($file) {
+            $prefix .= '> ' if $prefix;
-        $prefix .= "file $file";
-        $prefix .= ", line $lineno" if $lineno;
-        $prefix .= ": ";
-    }
-    if ($prefix) {
-        $prefix .= "> ";
             $buffer = "$prefix$buffer";
             $prefix =~ s/> $/  /;
             $buffer =~ s/\n/\n$prefix/g;
@@ -2375,14 +2385,21 @@ sub logmsg {
 
         if ($args{email}) {
             $emailbody .= $buffer;
-        if (!$_in_logmsg) {
+            if (!$self->{_in_logger}) {
-            ++$_in_logmsg;  # avoid infinite recursion if logger calls logmsg
+                ++$self->{_in_logger};  # Avoid infinite recursion if logger itself logs.
-            logger($buffer);
+                ddclient::logger($buffer);
-            --$_in_logmsg;
+                --$self->{_in_logger};
             }
         }
     }
-sub _logmsg_fmt { return (@_ > 1) ? sprintf(shift, @_) : shift; }
+}
+
+# Intended use:
+#     local $_l = pushlogctx('additional prefix goes here');
+sub pushlogctx { my ($ctx) = @_; return ddclient::Logger->new($ctx, $_l); }
+
+sub logmsg { $_l->log(@_); }
+sub _logmsg_fmt { $_[0] eq 'ctx' ? (shift, shift) : (), (@_ > 1) ? sprintf(shift, @_) : shift; }
 sub info    { logmsg(email => 1, label => 'INFO',    _logmsg_fmt(@_)) if opt('verbose'); }
 sub debug   { logmsg(            label => 'DEBUG',   _logmsg_fmt(@_)) if opt('debug'); }
 sub warning { logmsg(email => 1, label => 'WARNING', _logmsg_fmt(@_)); }
@@ -7365,7 +7382,7 @@ sub nic_emailonly_update {
     debug("\nnic_emailonly_update -------------------");
     # Note: This is logged after $config{$_}{'max-interval'] even if the IP address hasn't changed,
     # so it is best to avoid phrasing like, "IP address has changed."
-    logmsg(email => 1, join("\n", 'Host IP addresses:', map({
+    logmsg(email => 1, raw => 1, join("\n", 'Host IP addresses:', map({
         my $ipv4 = delete($config{$_}{'wantipv4'});
         my $ipv6 = delete($config{$_}{'wantipv6'});
         $config{$_}{'status-ipv4'} = 'good' if $ipv4;

t/logmsg.pl

@@ -60,7 +60,8 @@ my @test_cases = (
     {
         desc => 'multi-line label',
         args => [label => 'LBL', "foo\nbar"],
-        want => "LBL:     > foo\nLBL:       bar\n",
+        want => ("LBL:     > foo\n" .
+                 "LBL:       bar\n"),
     },
     {
         desc => 'single-line long label',
@@ -70,34 +71,40 @@ my @test_cases = (
     {
         desc => 'multi-line long label',
         args => [label => 'VERY LONG LABEL', "foo\nbar"],
-        want => "VERY LONG LABEL: > foo\nVERY LONG LABEL:   bar\n",
+        want => ("VERY LONG LABEL: > foo\n" .
+                 "VERY LONG LABEL:   bar\n"),
     },
     {
-        desc => 'single line, no label, file',
+        desc => 'single line, no label, single context',
         args => ['foo'],
-        file => 'name',
+        ctxs => ['only context'],
-        want => "file name: > foo\n",
+        want => "[only context]> foo\n",
     },
     {
-        desc => 'single line, no label, file, and line number',
+        desc => 'single line, no label, two contexts',
         args => ['foo'],
-        file => 'name',
+        ctxs => ['context one', 'context two'],
-        lineno => 42,
+        want => "[context one][context two]> foo\n",
-        want => "file name, line 42: > foo\n",
     },
     {
-        desc => 'single line, label, file, and line number',
+        desc => 'single line, label, two contexts',
         args => [label => 'LBL', 'foo'],
-        file => 'name',
+        ctxs => ['context one', 'context two'],
-        lineno => 42,
+        want => "LBL:     [context one][context two]> foo\n",
-        want => "LBL:     file name, line 42: > foo\n",
     },
     {
-        desc => 'multiple lines, label, file, and line number',
+        desc => 'multiple lines, label, two contexts',
         args => [label => 'LBL', "foo\nbar"],
-        file => 'name',
+        ctxs => ['context one', 'context two'],
-        lineno => 42,
+        want => ("LBL:     [context one][context two]> foo\n" .
-        want => "LBL:     file name, line 42: > foo\nLBL:     file name, line 42:   bar\n",
+                 "LBL:     [context one][context two]  bar\n"),
+    },
+    {
+        desc => '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"),
     },
 );
 
@@ -107,10 +114,8 @@ for my $tc (@test_cases) {
         my $output;
         open(my $fh, '>', \$output);
         $ddclient::emailbody = $tc->{init_email} // '';
-        local $ddclient::file = $tc->{file} // '';
+        local $ddclient::_l = $ddclient::_l;
-        $ddclient::file if 0;  # suppress spurious warning "Name used only once: possible typo"
+        $ddclient::_l = ddclient::pushlogctx($_) for @{$tc->{ctxs} // []};
-        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');
@@ -118,24 +123,38 @@ for my $tc (@test_cases) {
     }
 }
 
+my @logfmt_test_cases = (
     {
-    my $output;
+        desc => 'single argument is printed directly, not via sprintf',
-    open(my $fh, '>', \$output);
+        args => ['%%'],
-    local *STDERR = $fh;
+        want => "DEBUG:   > %%\n",
-    local $ddclient::globals{debug} = 1;
+    },
-    ddclient::debug('%%');
+    {
-    close($fh);
+        desc => 'multiple arguments are formatted via sprintf',
-    is($output, "DEBUG:   > %%\n", 'single argument is printed directly, not via sprintf');
+        args => ['%s', 'foo'],
-}
+        want => "DEBUG:   > foo\n",
+    },
+    {
+        desc => 'single argument with context',
+        args => [ctx => 'context', '%%'],
+        want => "DEBUG:   [context]> %%\n",
+    },
+    {
+        desc => 'multiple arguments with context',
+        args => [ctx => 'context', '%s', 'foo'],
+        want => "DEBUG:   [context]> foo\n",
+    },
+);
 
-{
+for my $tc (@logfmt_test_cases) {
-    my $output;
+    my $got;
-    open(my $fh, '>', \$output);
+    open(my $fh, '>', \$got);
     local *STDERR = $fh;
     local $ddclient::globals{debug} = 1;
-    ddclient::debug('%s', 'foo');
+    %ddclient::globals if 0;
+    ddclient::debug(@{$tc->{args}});
     close($fh);
-    is($output, "DEBUG:   > foo\n", 'multiple arguments are formatted via sprintf');
+    is($got, $tc->{want}, $tc->{desc});
 }
 
 done_testing();