From 62e4778f7c2be4114a51fb3ca871c15360df8725 Mon Sep 17 00:00:00 2001 From: Tomas Cohen Arazi Date: Mon, 28 Jun 2021 15:22:33 -0300 Subject: [PATCH] Bug 28615: Add a simple way to mock Koha::Logger This patch introduces a new way to mock and test Koha::Logger. As the POD says, it is used by calling my $logger = t::lib::Mocks::Logger->new(); It then provides convenient methods for testing the logging itself per log-level: * warn_is * warn_like * debug_is * debug_like ... Methods for counting the logging activity and also for clearing the mock buffer are provided as well. This is covered in the POD and also on the follow-up, that makes use of this to fix Auth_with_shibboleth.t To test: 1. Run: $ kshell k$ prove t/Auth_with_shibboleth.t => FAIL: Tests fail! It expects some warns but they are not returned by the lib 2. Apply this patches 3. Repeat 1 => SUCCESS: Tests pass! The tests now use the new lib, and they correctly find the logging Auth_with_shibboleth.pm does on function calls. 4. Sign off :-D Signed-off-by: Tomas Cohen Arazi Signed-off-by: Martin Renvoize --- t/lib/Mocks/Logger.pm | 323 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 323 insertions(+) create mode 100644 t/lib/Mocks/Logger.pm diff --git a/t/lib/Mocks/Logger.pm b/t/lib/Mocks/Logger.pm new file mode 100644 index 0000000000..8950d26a97 --- /dev/null +++ b/t/lib/Mocks/Logger.pm @@ -0,0 +1,323 @@ +package t::lib::Mocks::Logger; + +# This file is part of Koha. +# +# Koha 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 3 of the License, or +# (at your option) any later version. +# +# Koha 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 Koha; if not, see . + +use Modern::Perl; + +use base 'Test::Builder::Module'; +use base qw(Class::Accessor); + +use Test::MockModule qw(strict); +use Test::MockObject; + +my $CLASS = __PACKAGE__; + +=head1 NAME + +t::lib::Mocks::Logger - A library to mock Koha::Logger for testing + +=head1 API + +=head2 Methods + +=head3 new + + my $logger = t::lib::Mocks::Logger->new(); + +Mocks the Koha::Logger for testing purposes. The mocked subs (log levels) +return the passed string, in case we want to test the debugging string contents. + +=cut + +sub new { + my ( $class, $params ) = @_; + + my $mocked_logger_class = Test::MockModule->new("Koha::Logger"); + my $mocked_logger = Test::MockObject->new(); + + $mocked_logger_class->mock( + 'get', + sub { + return $mocked_logger; + } + ); + + my $self = $class->SUPER::new( + { logger => $mocked_logger_class, + debug => [], + error => [], + info => [], + fatal => [], + trace => [], + warn => [], + } + ); + bless $self, $class; + + foreach my $level (levels()) { + $mocked_logger->mock( + $level, + sub { + my $message = $_[1]; + push @{ $self->{$level} }, $message; + return $message; + } + ); + } + + return $self; +} + +=head3 debug_is + + $logger->debug_is($expected); + +Method for testing a message was written to the 'debug' log level. + +=cut + +sub debug_is { + my ( $self, $expect, $name ) = @_; $self->generic_is( 'debug', $expect, $name ); return $self; +} + +=head3 error_is + + $logger->error_is($expected); + +Method for testing a message was written to the 'error' log level. + +=cut + +sub error_is { + my ( $self, $expect, $name ) = @_; $self->generic_is( 'error', $expect, $name ); return $self; +} + +=head3 fatal_is + + $logger->fatal_is($expected); + +Method for testing a message was written to the 'fatal' log level. + +=cut + +sub fatal_is { + my ( $self, $expect, $name ) = @_; $self->generic_is( 'fatal', $expect, $name ); return $self; +} + +=head3 info_is + + $logger->info_is($expected); + +Method for testing a message was written to the 'info' log level. + +=cut + +sub info_is { + my ( $self, $expect, $name ) = @_; $self->generic_is( 'info', $expect, $name ); return $self; +} + +=head3 trace_is + + $logger->trace_is($expected); + +Method for testing a message was written to the 'trace' log level. + +=cut + +sub trace_is { + my ( $self, $expect, $name ) = @_; $self->generic_is( 'trace', $expect, $name ); return $self; +} + +=head3 warn_is + + $logger->warn_is($expected); + +Method for testing a message was written to the 'warn' log level. + +=cut + +sub warn_is { + my ( $self, $expect, $name ) = @_; $self->generic_is( 'warn', $expect, $name ); return $self; +} + +=head3 debug_like + + $logger->debug_like($expected); + +Method for testing a message matching a regex was written to the 'debug' log level. + +=cut + +sub debug_like { + my ( $self, $expect, $name ) = @_; $self->generic_like( 'debug', $expect, $name ); return $self; +} + +=head3 error_like + + $logger->error_like($expected); + +Method for testing a message matching a regex was written to the 'error' log level. + +=cut + +sub error_like { + my ( $self, $expect, $name ) = @_; $self->generic_like( 'error', $expect, $name ); return $self; +} + +=head3 fatal_like + + $logger->fatal_like($expected); + +Method for testing a message matching a regex was written to the 'fatal' log level. + +=cut + +sub fatal_like { + my ( $self, $expect, $name ) = @_; $self->generic_like( 'fatal', $expect, $name ); return $self; +} + +=head3 info_like + + $logger->info_like($expected); + +Method for testing a message matching a regex was written to the 'info' log level. + +=cut + +sub info_like { + my ( $self, $expect, $name ) = @_; $self->generic_like( 'info', $expect, $name ); return $self; +} + +=head3 trace_like + + $logger->trace_like($expected); + +Method for testing a message matching a regex was written to the 'trace' log level. + +=cut + +sub trace_like { + my ( $self, $expect, $name ) = @_; $self->generic_like( 'trace', $expect, $name ); return $self; +} + +=head3 warn_like + + $logger->warn_like($expected); + +Method for testing a message matching a regex was written to the 'warn' log level. + +=cut + +sub warn_like { + my ( $self, $expect, $name ) = @_; $self->generic_like( 'warn', $expect, $name ); return $self; +} + +=head3 count + + is( $logger->count( [ $level ] ), 0 'No logs!' ); + +Method for counting the generated messages. An optional I<$level> parameter +can be passed to restrict the count to the passed level. + +=cut + +sub count { + my ( $self, $level ) = @_; + + unless ( $level ) { + my $sum = 0; + + map { $sum += scalar @{$self->{$_}} } levels(); + + return $sum; + } + + return scalar @{ $self->{$level} }; +} + +=head3 clear + + $logger->debug_is( "Something", "Something was sent to 'debug'" ) + ->warn_like( qr/^Something$/, "Something was sent to 'warn" ) + ->clear( [ $level ] ); + +A method for resetting the mocked I<$logger> object buffer. Useful to avoid inter-tests +pollution. + +=cut + +sub clear { + my ( $self, $level ) = @_; + + if ( $level ) { + $self->{$level} = []; + } + else { + foreach my $l (levels()) { + $self->{$l} = []; + } + } + + return $self; +} + +=head2 Internal methods + +=head3 generic_is + +Internal method to be used to build log level-specific exact string test methods. + +=cut + +sub generic_is { + my ( $self, $level, $expect, $name ) = @_; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + + my $string = shift @{ $self->{$level} }; + $string //= ''; + my $tb = $CLASS->builder; + return $tb->is_eq( $string, $expect, $name); +} + +=head3 generic_like + +Internal method to be used to build log level-specific regex string test methods. + +=cut + +sub generic_like { + my ( $self, $level, $expect, $name ) = @_; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + + my $string = shift @{ $self->{$level} }; + $string //= ''; + my $tb = $CLASS->builder; + return $tb->like( $string, $expect, $name); +} + +=head3 levels + +Internal method that returns a list of valid log levels. + +=cut + +sub levels { + return qw(trace debug info warn error fatal); +} + +1; -- 2.20.1