Replacement of hot filehandlers for Mojo::Log (#876)

This change will replace writing to the autoinst-log.txt with
a hot filehandler, with a proper logging mechanism: Mojo::Log

bmwqemu.pm

@@ -23,12 +23,12 @@ use Fcntl ':flock';
 
 use Thread::Queue;
 use POSIX;
-use Term::ANSIColor;
 use Carp;
 use JSON;
 use File::Path 'remove_tree';
 use Data::Dumper;
-
+use Mojo::Log;
+use File::Spec::Functions;
 use base 'Exporter';
 use Exporter;
 
@@ -53,9 +53,8 @@ our $screenshotpath = "qemuscreenshot";
 
 # global vars
 
-our $logfd;
+our $logger;
 
-our $istty;
 our $direct_output;
 
 # Known locations of OVMF (UEFI) firmware: first is openSUSE, second is
@@ -113,15 +112,17 @@ sub init {
     mkdir join('/', result_dir, 'ulogs');
 
     if ($direct_output) {
-        open($logfd, '>&STDERR');
+        $logger = Mojo::Log->new(level => 'debug');
     }
     else {
-        open($logfd, ">", result_dir . "/autoinst-log.txt");
+        $logger = Mojo::Log->new(level => 'debug', path => catfile(result_dir, 'autoinst-log.txt'));
     }
-    # set unbuffered so that send_key lines from main thread will be written
-    my $oldfh = select($logfd);
-    $| = 1;
-    select($oldfh);
+
+    $logger->format(
+        sub {
+            my ($time, $level, @lines) = @_;
+            return '[' . localtime($time) . "] [$$:$level] " . join "\n", @lines, '';
+        });
 
     die "CASEDIR variable not set in vars.json, unknown test case directory" if !$vars{CASEDIR};
 
@@ -182,55 +183,43 @@ sub get_timestamp {
     return sprintf "%s.%04d ", (POSIX::strftime "%H:%M:%S", gmtime($t)), 10000 * ($t - int($t));
 }
 
-sub print_possibly_colored {
-    my ($text, $color) = @_;
-
-    if (($direct_output && !$istty) || !$direct_output) {
-        $logfd && print $logfd get_timestamp() . "$$ $text\n";
-    }
-    if ($istty || !$logfd) {
-        if ($color) {
-            print STDERR colored(get_timestamp() . "$$ " . $text, $color) . "\n";
-        }
-        else {
-            print STDERR get_timestamp() . "$$ $text\n";
-        }
-    }
-    return;
-}
-
 sub diag {
-    print_possibly_colored "@_";
+    $logger = Mojo::Log->new(level => 'debug') unless $logger;
+    $logger->debug("@_");
     return;
 }
 
 sub fctres {
     my ($text, $fname) = @_;
 
     $fname //= (caller(1))[3];
-    print_possibly_colored ">>> $fname: $text", 'green';
+    $logger = Mojo::Log->new(level => 'debug') unless $logger;
+    $logger->debug(">>> $fname: $text");
     return;
 }
 
 sub fctinfo {
     my ($text, $fname) = @_;
 
     $fname //= (caller(1))[3];
-    print_possibly_colored "::: $fname: $text", 'yellow';
+    $logger = Mojo::Log->new(level => 'debug') unless $logger;
+    $logger->info("::: $fname: $text");
     return;
 }
 
 sub fctwarn {
     my ($text, $fname) = @_;
 
     $fname //= (caller(1))[3];
-    print_possibly_colored "!!! $fname: $text", 'red';
+    $logger = Mojo::Log->new(level => 'debug') unless $logger;
+    $logger->warn("!!! $fname: $text");
     return;
 }
 
 sub modstart {
     my $text = sprintf "||| %s at %s", join(' ', @_), POSIX::strftime("%F %T", gmtime);
-    print_possibly_colored $text, 'bold';
+    $logger = Mojo::Log->new(level => 'debug') unless $logger;
+    $logger->debug($text);
     return;
 }
 
@@ -248,7 +237,7 @@ sub update_line_number {
         my ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash) = caller($i);
         last unless $filename;
         next unless $filename =~ m/$ending$/;
-        print get_timestamp() . "Debug: $filename:$line called $subroutine\n";
+        $logger->debug("$filename:$line called $subroutine");
         last;
     }
     return;
@@ -270,8 +259,8 @@ sub log_call {
         push @result, join("=", $key, pp($value));
     }
     my $params = join(", ", @result);
-
-    print_possibly_colored '<<< ' . $fname . "($params)", 'blue';
+    $logger = Mojo::Log->new(level => 'debug') unless $logger;
+    $logger->debug('<<< ' . $fname . "($params)");
     return;
 }
 
@@ -292,10 +281,6 @@ sub fileContent {
 sub stop_vm {
     return unless $backend;
     my $ret = $backend->stop();
-    if (!$direct_output && $logfd) {
-        close $logfd;
-        $logfd = undef;
-    }
     return $ret;
 }
 

cpanfile

@@ -33,13 +33,13 @@ requires 'List::MoreUtils';
 requires 'List::Util';
 requires 'Mojo::URL';
 requires 'Mojo::UserAgent';
+requires 'Mojo::Log';
 requires 'Mojolicious::Lite';
 requires 'Net::DBus';
 requires 'Net::SNMP';
 requires 'Net::SSH2';
 requires 'POSIX';
 requires 'Perl::Tidy';
-requires 'Term::ANSIColor';
 requires 'Test::Compile';
 requires 'Test::More';
 requires 'Test::Simple';

isotovideo

@@ -97,15 +97,14 @@ version() if $options{version};
 
 
 # enable debug default when started from a tty
-$bmwqemu::istty         = -t 1;              ## no critic
 $bmwqemu::direct_output = $options{debug};
 
 # whether tests completed (or we bailed due to a failed 'fatal' test)
 my $completed = 0;
 
 select(STDERR);
 $| = 1;
-select(STDOUT);                              # default
+select(STDOUT);    # default
 $| = 1;
 
 $bmwqemu::scriptdir = $installprefix;

t/10-terminal.t

@@ -19,6 +19,7 @@ use POSIX qw( :sys_wait_h sigprocmask sigsuspend );
 use Socket qw( PF_UNIX SOCK_STREAM sockaddr_un );
 use Time::HiRes 'usleep';
 use File::Temp 'tempfile';
+use Mojo::Log;
 
 use Test::More;
 use Test::Warnings;
@@ -71,11 +72,7 @@ my ($logfd, $log_path) = tempfile('10-terminalXXXXX',       TMPDIR => 1, SUFFIX
 my ($errfd, $err_path) = tempfile('10-terminal-ERRORXXXXX', TMPDIR => 1, SUFFIX => '.log');
 
 $bmwqemu::direct_output = 0;
-$bmwqemu::logfd         = $errfd;
-$bmwqemu::istty         = 0;
-
-# Line buffer the error log (make it hot)
-select((select($errfd), $| = 1)[0]);
+$bmwqemu::logger = Mojo::Log->new(path => $err_path);
 
 # Either write $msg to the socket or die
 sub try_write {

t/15-logging.t

@@ -0,0 +1,82 @@
+#!/usr/bin/env perl -w
+
+# Copyright (C) 2017 SUSE LLC
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+
+use strict;
+use warnings;
+use Test::More;
+use bmwqemu;
+use Mojo::File 'tempfile';
+use Data::Dumper;
+
+
+subtest 'Logging to STDERR' => sub {
+
+    # Capture STDERR:
+    # 1- dups the current STDERR to $oldSTDERR. This is used to restore the STDERR later
+    # 2- Closes the current STDERR
+    # 2- Links the STDERR to the variable
+    open(my $oldSTDERR, ">&", STDERR) or die "Can't preserve STDERR\n$!\n";
+    close STDERR;
+    my $output;
+    open STDERR, '>', \$output;
+    ### Testing code here ###
+
+    my $re = qr/Via .*? function/;
+
+    bmwqemu::diag('Via diag function');
+    bmwqemu::fctres('Via fctres function');
+    bmwqemu::fctinfo('Via fctinfo function');
+    bmwqemu::fctwarn('Via fctwarn function');
+    bmwqemu::modstart('Via modstart function');
+
+    my @matches = ($output =~ m/$re/gm);
+    ok(@matches == 5, 'All messages logged to STDERR');
+    my $i = 0;
+    ok($matches[$i++] =~ /$_/, "Logging $_ match!") for ('diag', 'fctres', 'fctinfo', 'fctwarn', 'modstart');
+
+    ### End of the Testing code ###
+    # Close the capture (current stdout) and restore STDOUT (by dupping the old STDOUT);
+    close STDERR;
+    open(STDERR, '>&', $oldSTDERR) or die "Can't dup \$oldSTDERR: $!";
+
+
+};
+
+subtest 'Logging to file' => sub {
+
+    my $log_file = tempfile;
+    $bmwqemu::logger = Mojo::Log->new(path => $log_file);
+    my $re = qr/Via .*? function/;
+
+    bmwqemu::diag('Via diag function');
+    bmwqemu::fctres('Via fctres function');
+    bmwqemu::fctinfo('Via fctinfo function');
+    bmwqemu::fctwarn('Via fctwarn function');
+    bmwqemu::modstart('Via modstart function');
+
+    my @matches = (Mojo::File->new($log_file)->slurp =~ m/$re/gm);
+    ok(@matches == 5, 'All messages logged to file');
+    my $i = 0;
+    ok($matches[$i++] =~ /$_/, "Logging $_ match!") for ('diag', 'fctres', 'fctinfo', 'fctwarn', 'modstart');
+};
+
+
+
+
+done_testing;