View | Details | Raw Unified | Return to bug 28615
Collapse All | Expand All

(-)a/t/lib/Mocks/Logger.pm (-1 / +323 lines)
Line 0 Link Here
0
- 
1
package t::lib::Mocks::Logger;
2
3
# This file is part of Koha.
4
#
5
# Koha is free software; you can redistribute it and/or modify it
6
# under the terms of the GNU General Public License as published by
7
# the Free Software Foundation; either version 3 of the License, or
8
# (at your option) any later version.
9
#
10
# Koha is distributed in the hope that it will be useful, but
11
# WITHOUT ANY WARRANTY; without even the implied warranty of
12
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13
# GNU General Public License for more details.
14
#
15
# You should have received a copy of the GNU General Public License
16
# along with Koha; if not, see <http://www.gnu.org/licenses>.
17
18
use Modern::Perl;
19
20
use base 'Test::Builder::Module';
21
use base qw(Class::Accessor);
22
23
use Test::MockModule qw(strict);
24
use Test::MockObject;
25
26
my $CLASS = __PACKAGE__;
27
28
=head1 NAME
29
30
t::lib::Mocks::Logger - A library to mock Koha::Logger for testing
31
32
=head1 API
33
34
=head2 Methods
35
36
=head3 new
37
38
    my $logger = t::lib::Mocks::Logger->new();
39
40
Mocks the Koha::Logger for testing purposes. The mocked subs (log levels)
41
return the passed string, in case we want to test the debugging string contents.
42
43
=cut
44
45
sub new {
46
    my ( $class, $params ) = @_;
47
48
    my $mocked_logger_class = Test::MockModule->new("Koha::Logger");
49
    my $mocked_logger = Test::MockObject->new();
50
51
    $mocked_logger_class->mock(
52
        'get',
53
        sub {
54
            return $mocked_logger;
55
        }
56
    );
57
58
    my $self = $class->SUPER::new(
59
        {   logger => $mocked_logger_class,
60
            debug  => [],
61
            error  => [],
62
            info   => [],
63
            fatal  => [],
64
            trace  => [],
65
            warn   => [],
66
        }
67
    );
68
    bless $self, $class;
69
70
    foreach my $level (levels()) {
71
        $mocked_logger->mock(
72
            $level,
73
            sub {
74
                my $message = $_[1];
75
                push @{ $self->{$level} }, $message;
76
                return $message;
77
            }
78
        );
79
    }
80
81
    return $self;
82
}
83
84
=head3 debug_is
85
86
    $logger->debug_is($expected);
87
88
Method for testing a message was written to the 'debug' log level.
89
90
=cut
91
92
sub debug_is {
93
    my ( $self, $expect, $name ) = @_; $self->generic_is( 'debug', $expect, $name ); return $self;
94
}
95
96
=head3 error_is
97
98
    $logger->error_is($expected);
99
100
Method for testing a message was written to the 'error' log level.
101
102
=cut
103
104
sub error_is {
105
    my ( $self, $expect, $name ) = @_; $self->generic_is( 'error', $expect, $name ); return $self;
106
}
107
108
=head3 fatal_is
109
110
    $logger->fatal_is($expected);
111
112
Method for testing a message was written to the 'fatal' log level.
113
114
=cut
115
116
sub fatal_is {
117
    my ( $self, $expect, $name ) = @_; $self->generic_is( 'fatal', $expect, $name ); return $self;
118
}
119
120
=head3 info_is
121
122
    $logger->info_is($expected);
123
124
Method for testing a message was written to the 'info' log level.
125
126
=cut
127
128
sub info_is {
129
    my ( $self, $expect, $name ) = @_; $self->generic_is( 'info', $expect, $name ); return $self;
130
}
131
132
=head3 trace_is
133
134
    $logger->trace_is($expected);
135
136
Method for testing a message was written to the 'trace' log level.
137
138
=cut
139
140
sub trace_is {
141
    my ( $self, $expect, $name ) = @_; $self->generic_is( 'trace', $expect, $name ); return $self;
142
}
143
144
=head3 warn_is
145
146
    $logger->warn_is($expected);
147
148
Method for testing a message was written to the 'warn' log level.
149
150
=cut
151
152
sub warn_is {
153
    my ( $self, $expect, $name ) = @_; $self->generic_is( 'warn', $expect, $name ); return $self;
154
}
155
156
=head3 debug_like
157
158
    $logger->debug_like($expected);
159
160
Method for testing a message matching a regex was written to the 'debug' log level.
161
162
=cut
163
164
sub debug_like {
165
    my ( $self, $expect, $name ) = @_; $self->generic_like( 'debug', $expect, $name ); return $self;
166
}
167
168
=head3 error_like
169
170
    $logger->error_like($expected);
171
172
Method for testing a message matching a regex was written to the 'error' log level.
173
174
=cut
175
176
sub error_like {
177
    my ( $self, $expect, $name ) = @_; $self->generic_like( 'error', $expect, $name ); return $self;
178
}
179
180
=head3 fatal_like
181
182
    $logger->fatal_like($expected);
183
184
Method for testing a message matching a regex was written to the 'fatal' log level.
185
186
=cut
187
188
sub fatal_like {
189
    my ( $self, $expect, $name ) = @_; $self->generic_like( 'fatal', $expect, $name ); return $self;
190
}
191
192
=head3 info_like
193
194
    $logger->info_like($expected);
195
196
Method for testing a message matching a regex was written to the 'info' log level.
197
198
=cut
199
200
sub info_like {
201
    my ( $self, $expect, $name ) = @_; $self->generic_like( 'info', $expect, $name ); return $self;
202
}
203
204
=head3 trace_like
205
206
    $logger->trace_like($expected);
207
208
Method for testing a message matching a regex was written to the 'trace' log level.
209
210
=cut
211
212
sub trace_like {
213
    my ( $self, $expect, $name ) = @_; $self->generic_like( 'trace', $expect, $name ); return $self;
214
}
215
216
=head3 warn_like
217
218
    $logger->warn_like($expected);
219
220
Method for testing a message matching a regex was written to the 'warn' log level.
221
222
=cut
223
224
sub warn_like {
225
    my ( $self, $expect, $name ) = @_; $self->generic_like( 'warn', $expect, $name ); return $self;
226
}
227
228
=head3 count
229
230
    is( $logger->count( [ $level ] ), 0 'No logs!' );
231
232
Method for counting the generated messages. An optional I<$level> parameter
233
can be passed to restrict the count to the passed level.
234
235
=cut
236
237
sub count {
238
    my ( $self, $level ) = @_;
239
240
    unless ( $level ) {
241
        my $sum = 0;
242
243
        map { $sum += scalar @{$self->{$_}} } levels();
244
245
        return $sum;
246
    }
247
248
    return scalar @{ $self->{$level} };
249
}
250
251
=head3 clear
252
253
    $logger->debug_is( "Something", "Something was sent to 'debug'" )
254
           ->warn_like( qr/^Something$/, "Something was sent to 'warn" )
255
           ->clear( [ $level ] );
256
257
A method for resetting the mocked I<$logger> object buffer. Useful to avoid inter-tests
258
pollution.
259
260
=cut
261
262
sub clear {
263
    my ( $self, $level ) = @_;
264
265
    if ( $level ) {
266
        $self->{$level} = [];
267
    }
268
    else {
269
        foreach my $l (levels()) {
270
            $self->{$l} = [];
271
        }
272
    }
273
274
    return $self;
275
}
276
277
=head2 Internal methods
278
279
=head3 generic_is
280
281
Internal method to be used to build log level-specific exact string test methods.
282
283
=cut
284
285
sub generic_is {
286
    my ( $self, $level, $expect, $name ) = @_;
287
288
    local $Test::Builder::Level = $Test::Builder::Level + 1;
289
290
    my $string = shift @{ $self->{$level} };
291
    $string //= '';
292
    my $tb = $CLASS->builder;
293
    return $tb->is_eq( $string, $expect, $name);
294
}
295
296
=head3 generic_like
297
298
Internal method to be used to build log level-specific regex string test methods.
299
300
=cut
301
302
sub generic_like {
303
    my ( $self, $level, $expect, $name ) = @_;
304
305
    local $Test::Builder::Level = $Test::Builder::Level + 1;
306
307
    my $string = shift @{ $self->{$level} };
308
    $string //= '';
309
    my $tb = $CLASS->builder;
310
    return $tb->like( $string, $expect, $name);
311
}
312
313
=head3 levels
314
315
Internal method that returns a list of valid log levels.
316
317
=cut
318
319
sub levels {
320
    return qw(trace debug info warn error fatal);
321
}
322
323
1;

Return to bug 28615