logmsg: New low-level logging interface

Makefile.am

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

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
+## Logging
-## debug
-## warning
-## fatal
 ######################################################################
-my $_in_msg = 0;
+my $_in_logmsg = 0;
-sub _msg {
+sub logmsg {
-    my $fh     = shift;
+    my %args = (
-    my $email  = shift;
+        msg => '',
-    my $prefix = shift;
+        pfx => '',
-    my $format = shift;
+        fh => *STDERR,
-    my $buffer = sprintf $format, @_;
+        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) {
+        if (!$_in_logmsg) {
-            ++$_in_msg;  # avoid infinite recursion if logger calls _msg
+            ++$_in_logmsg;  # avoid infinite recursion if logger calls logmsg
             logger($buffer);
-            --$_in_msg;
+            --$_in_logmsg;
         }
     }
-
 }
-sub msg     { _msg(*STDOUT, 0, '',         @_);                                   }
+sub msg     { logmsg(fh => *STDOUT,                                sprintf(shift, @_)); }
-sub verbose { _msg(*STDOUT, 1, @_)             if opt('verbose');                 }
+sub verbose { logmsg(fh => *STDOUT, email => 1, pfx => pop,        sprintf(shift, @_)) if opt('verbose'); }
-sub info    { _msg(*STDOUT, 1, 'INFO:',    @_) if opt('verbose');                 }
+sub info    { logmsg(fh => *STDOUT, email => 1, pfx => 'INFO:',    sprintf(shift, @_)) if opt('verbose'); }
-sub debug   { _msg(*STDOUT, 0, 'DEBUG:',   @_) if opt('debug');                   }
+sub debug   { logmsg(fh => *STDOUT,             pfx => 'DEBUG:',   sprintf(shift, @_)) if opt('debug'); }
-sub debug2  { _msg(*STDOUT, 0, 'DEBUG:',   @_) if opt('debug') && opt('verbose'); }
+sub debug2  { logmsg(fh => *STDOUT,             pfx => 'DEBUG:',   sprintf(shift, @_)) if opt('debug') && opt('verbose'); }
-sub warning { _msg(*STDERR, 1, 'WARNING:', @_);                                   }
+sub warning { logmsg(               email => 1, pfx => 'WARNING:', sprintf(shift, @_)); }
-sub fatal   { _msg(*STDERR, 1, 'FATAL:',   @_); sendmail(); exit(1);              }
+sub fatal   { logmsg(               email => 1, pfx => 'FATAL:',   sprintf(shift, @_)); sendmail(); exit(1); }
-sub success { _msg(*STDOUT, 1, 'SUCCESS:', @_);                                   }
+sub success { logmsg(fh => *STDOUT, email => 1, pfx => 'SUCCESS:', sprintf(shift, @_)); }
-sub failed  { _msg(*STDERR, 1, 'FAILED:',  @_); $result = 'FAILED';               }
+sub failed  { logmsg(               email => 1, pfx => 'FAILED:',  sprintf(shift, @_)); $result = 'FAILED'; }
 sub prettytime { return scalar(localtime(shift)); }
 
 sub prettyinterval {

t/logmsg.pl

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