Browse Source

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 <tomascohen@theke.io>
Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>

Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>
Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>
master
Tomas Cohen Arazi 3 months ago
parent
commit
5754411d66
  1. 323
      t/lib/Mocks/Logger.pm

323
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 <http://www.gnu.org/licenses>.
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;
Loading…
Cancel
Save