--- /dev/null
+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;
projects / srvgit / commitdiff