1package Dancer2::Core::Role::Logger;
2# ABSTRACT: Role for logger engines
3$Dancer2::Core::Role::Logger::VERSION = '0.301004';
4use Dancer2::Core::Types;
5
6use Moo::Role;
7use POSIX 'strftime';
8use Encode ();
9use Data::Dumper;
10
11with 'Dancer2::Core::Role::Engine';
12
13sub hook_aliases { +{} }
14sub supported_hooks {
15    qw(
16      engine.logger.before
17      engine.logger.after
18    );
19}
20
21sub _build_type {'Logger'}
22
23# This is the only method to implement by logger engines.
24# It receives the following arguments:
25# $msg_level, $msg_content, it gets called only if the configuration allows
26# a message of the given level to be logged.
27requires 'log';
28
29has auto_encoding_charset => (
30    is  => 'ro',
31    isa => Str,
32);
33
34has app_name => (
35    is      => 'ro',
36    isa     => Str,
37    default => sub {'-'},
38);
39
40has log_format => (
41    is      => 'rw',
42    isa     => Str,
43    default => sub {'[%a:%P] %L @%T> %m in %f l. %l'},
44);
45
46my $_levels = {
47
48    # levels < 0 are for core only
49    core => -10,
50
51    # levels > 0 are for end-users only
52    debug   => 1,
53    info    => 2,
54    warn    => 3,
55    warning => 3,
56    error   => 4,
57};
58
59has log_level => (
60    is  => 'rw',
61    isa => Enum[keys %{$_levels}],
62    default => sub {'debug'},
63);
64
65sub _should {
66    my ( $self, $msg_level ) = @_;
67    my $conf_level = $self->log_level;
68    return $_levels->{$conf_level} <= $_levels->{$msg_level};
69}
70
71sub format_message {
72    my ( $self, $level, $message ) = @_;
73    chomp $message;
74
75    $message = Encode::encode( $self->auto_encoding_charset, $message )
76      if $self->auto_encoding_charset;
77
78    my @stack = caller(8);
79    my $request = $self->request;
80    my $config = $self->config;
81
82    my $block_handler = sub {
83        my ( $block, $type ) = @_;
84        if ( $type eq 't' ) {
85            return POSIX::strftime( $block, localtime(time) );
86        }
87        elsif ( $type eq 'h' ) {
88            return ( $request && $request->header($block) ) || '-';
89        }
90        else {
91            Carp::carp("{$block}$type not supported");
92            return "-";
93        }
94    };
95
96    my $chars_mapping = {
97        a => sub { $self->app_name },
98        t => sub { POSIX::strftime( "%d/%b/%Y %H:%M:%S", localtime(time) ) },
99        T => sub { POSIX::strftime( "%Y-%m-%d %H:%M:%S", localtime(time) ) },
100        u => sub { POSIX::strftime( "%d/%b/%Y %H:%M:%S", gmtime(time) ) },
101        U => sub { POSIX::strftime( "%Y-%m-%d %H:%M:%S", gmtime(time) ) },
102        P => sub {$$},
103        L => sub {$level},
104        m => sub {$message},
105        f => sub { $stack[1] || '-' },
106        l => sub { $stack[2] || '-' },
107        h => sub {
108            ( $request && ( $request->remote_host || $request->address ) ) || '-'
109        },
110        i => sub { ( $request && $request->id ) || '-' },
111    };
112
113    my $char_mapping = sub {
114        my $char = shift;
115
116        my $cb = $chars_mapping->{$char};
117        if ( !$cb ) {
118            Carp::carp "%$char not supported.";
119            return "-";
120        }
121        $cb->($char);
122    };
123
124    my $fmt = $self->log_format;
125
126    $fmt =~ s/
127        (?:
128            \%\{(.+?)\}([a-z])|
129            \%([a-zA-Z])
130        )
131    / $1 ? $block_handler->($1, $2) : $char_mapping->($3) /egx;
132
133    return $fmt . "\n";
134}
135
136sub _serialize {
137    my @vars = @_;
138
139    return join q{}, map +(
140        ref $_
141          ? Data::Dumper->new( [$_] )->Terse(1)->Purity(1)->Indent(0)
142          ->Sortkeys(1)->Dump()
143          : ( defined($_) ? $_ : 'undef' )
144    ), @vars;
145}
146
147around 'log' => sub {
148    my ($orig, $self, @args) = @_;
149
150    $self->execute_hook( 'engine.logger.before', $self, @args );
151    $self->$orig( @args );
152    $self->execute_hook( 'engine.logger.after', $self, @args );
153};
154
155sub core {
156    my ( $self, @args ) = @_;
157    $self->_should('core') and $self->log( 'core', _serialize(@args) );
158}
159
160sub debug {
161    my ( $self, @args ) = @_;
162    $self->_should('debug') and $self->log( 'debug', _serialize(@args) );
163}
164
165sub info {
166    my ( $self, @args ) = @_;
167    $self->_should('info') and $self->log( 'info', _serialize(@args) );
168}
169
170sub warning {
171    my ( $self, @args ) = @_;
172    $self->_should('warning') and $self->log( 'warning', _serialize(@args) );
173}
174
175sub error {
176    my ( $self, @args ) = @_;
177    $self->_should('error') and $self->log( 'error', _serialize(@args) );
178}
179
1801;
181
182__END__
183
184=pod
185
186=encoding UTF-8
187
188=head1 NAME
189
190Dancer2::Core::Role::Logger - Role for logger engines
191
192=head1 VERSION
193
194version 0.301004
195
196=head1 DESCRIPTION
197
198Any class that consumes this role will be able to implement to write log messages.
199
200In order to implement this role, the consumer B<must> implement the C<log>
201method. This method will receives as argument the C<level> and the C<message>.
202
203=head1 ATTRIBUTES
204
205=head2 auto_encoding_charset
206
207Charset to use when writing a message.
208
209=head2 app_name
210
211Name of the application. Can be used in the message.
212
213=head2 log_format
214
215This is a format string (or a preset name) to specify the log format.
216
217The possible values are:
218
219=over 4
220
221=item %h
222
223host emitting the request
224
225=item %t
226
227date (local timezone, formatted like %d/%b/%Y %H:%M:%S)
228
229=item %T
230
231date (local timezone, formatted like %Y-%m-%d %H:%M:%S)
232
233=item %u
234
235date (UTC timezone, formatted like %d/%b/%Y %H:%M:%S)
236
237=item %U
238
239date (UTC timezone, formatted like %Y-%m-%d %H:%M:%S)
240
241=item %P
242
243PID
244
245=item %L
246
247log level
248
249=item %D
250
251timer
252
253=item %m
254
255message
256
257=item %f
258
259file name that emit the message
260
261=item %l
262
263line from the file
264
265=item %i
266
267request ID
268
269=item %{$fmt}t
270
271timer formatted with a valid time format
272
273=item %{header}h
274
275header value
276
277=back
278
279=head2 log_level
280
281Level to use by default.
282
283=head1 METHODS
284
285=head2 core
286
287Log messages as B<core>.
288
289=head2 debug
290
291Log messages as B<debug>.
292
293=head2 info
294
295Log messages as B<info>.
296
297=head2 warning
298
299Log messages as B<warning>.
300
301=head2 error
302
303Log messages as B<error>.
304
305=head2 format_message
306
307Provides a common message formatting.
308
309=head1 CONFIGURATION
310
311The B<logger> configuration variable tells Dancer2 which engine to use.
312
313You can change it either in your config.yml file:
314
315    # logging to console
316    logger: "console"
317
318The log format can also be configured,
319please see L<Dancer2::Core::Role::Logger/"log_format"> for details.
320
321=head1 AUTHOR
322
323Dancer Core Developers
324
325=head1 COPYRIGHT AND LICENSE
326
327This software is copyright (c) 2021 by Alexis Sukrieh.
328
329This is free software; you can redistribute it and/or modify it under
330the same terms as the Perl 5 programming language system itself.
331
332=cut
333