File Coverage

blib/lib/Kelp/Module/Logger.pm
Criterion Covered Total %
statement 31 31 100.0
branch 1 2 50.0
condition n/a
subroutine 9 9 100.0
pod 1 2 50.0
total 42 44 95.4


line stmt bran cond sub pod time code
1             package Kelp::Module::Logger;
2              
3 1     1   478 use Kelp::Base 'Kelp::Module';
  1         2  
  1         6  
4              
5 1     1   65 use Carp;
  1         3  
  1         51  
6 1     1   613 use Log::Dispatch;
  1         226513  
  1         36  
7 1     1   10 use Data::Dumper;
  1         2  
  1         378  
8              
9             sub _logger {
10 1     1   2 my ( $self, %args ) = @_;
11 1         5 Log::Dispatch->new(%args);
12             }
13              
14             sub build {
15 1     1 1 5 my ( $self, %args ) = @_;
16 1         4 $self->{logger} = $self->_logger(%args);
17              
18             # Register a few levels
19 1         54 my @levels_to_register = qw/debug info error/;
20              
21             # Build the registration hash
22             my %LEVELS = map {
23 1         3 my $level = $_;
  3         6  
24             $level => sub {
25 3     3   90 shift;
26 3         8 $self->message( $level, @_ );
27 3         11 };
28             } @levels_to_register;
29              
30             # Register the log levels
31 1         9 $self->register(%LEVELS);
32              
33             # Also register the message method as 'logger'
34             $self->register( logger => sub {
35 1     1   48 shift;
36 1         4 $self->message(@_);
37 1         6 });
38             }
39              
40             sub message {
41 4     4 0 9 my ( $self, $level, @messages ) = @_;
42 4         113 my @a = localtime(time);
43 4         32 my $date = sprintf(
44             "%4i-%02i-%02i %02i:%02i:%02i",
45             $a[5] + 1900,
46             $a[4] + 1,
47             $a[3], $a[2], $a[1], $a[0]
48             );
49              
50 4         10 for (@messages) {
51             $self->{logger}->log(
52 4 50       31 level => $level,
53             message => sprintf( '%s - %s - %s',
54             $date, $level, ref($_) ? Dumper($_) : $_ )
55             );
56             }
57             }
58              
59             1;
60              
61             __END__
62              
63             =pod
64              
65             =head1 NAME
66              
67             Kelp::Module::Logger - Logger for Kelp applications
68              
69             =head1 SYNOPSIS
70              
71             # conf/config.pl
72             {
73             modules => ['Logger'],
74             modules_init => {
75             Logger => {
76             outputs => [
77             [ 'Screen', min_level => 'debug', newline => 1 ],
78             ]
79             },
80             },
81             }
82              
83             # lib/MyApp.pm
84             sub run {
85             my $self = shift;
86             my $app = $self->SUPER::run(@_);
87             ...;
88             $app->info('Kelp is ready to rock!');
89             return $app;
90             }
91              
92              
93             =head1 DESCRIPTION
94              
95             This module provides an log interface for Kelp web application. It uses
96             L<Log::Dispatch> as underlying logging module.
97              
98             =head1 REGISTERED METHODS
99              
100             =head2 debug
101              
102             =head2 info
103              
104             =head2 error
105              
106             =cut