Line # Revision Author
1 3 ahitrov@rambler.ru package Contenido::Logger;
2 use base 'Log::Dispatch';
3 use strict;
4 use Log::Dispatch::Screen;
5 use Carp;
6
7 =head1 NAME
8
9 Contenido::Logger - Log wrapper for conenido around Log::Dispatch.
10
11 =head1 SYNOPSIS
12
13 my $log = Contenido::Logger->new();
14 $log->debug('Hello world');
15 $log->error('SMX code is wrong');
16 $log->emergency('Fuck!');
17
18 =head1 DESCRIPTION
19
20 Not yet
21
22 =head1 METHODS
23
24 =head2 new
25
26 Contenido::Logger->new(%options);
27
28 =head2 instance
29
30 Contenido::Logger->instance(%options);
31
32
33 =over
34
35 Options:
36
37 =item *
38
39 min_level: minimum level of logging
40 [debug info notice warning error critical alert emergency].
41
42 =item *
43
44 max_level: maximum level of logging
45
46 =item *
47
48 callback: custom callback when logging (instead of default).
49 CODE reference. See L<Log::Dispatch> for more info.
50
51 =item *
52
53 log_format: custom log format style. Default to '%d %C:%L(%P) [%l]: %m%n'.
54
55 =over
56
57 Where:
58
59 =item *
60
61 %d - date (format [mday/mon/year hour:min:sec])
62
63 =item *
64
65 %P - current process ID
66
67 =item *
68
69 %C - name of package caused this log
70
71 =item *
72
73 %L - code line in %C
74
75 =item *
76
77 %l - log level
78
79 =item *
80
81 %m - log text
82
83 =item *
84
85 %n - "\n"
86
87 =back
88
89 =item *
90
91 stack_trace: enable stack trace on log levels warning, ..., emergency. Boolean.
92
93 =back
94
95 =cut
96
97 our @levels = qw/debug info notice warning error critical alert emergency/;
98 my $i = 0;
99 our %levels = map { $_ => $i++ } @levels;
100 $levels{emerg} = $levels{emergency};
101 $levels{err} = $levels{error};
102 $levels{crit} = $levels{critical};
103 my $instance;
104
105 sub new {
106 my ($this, %opts) = @_;
107 $this = ref $this if ref $this;
108
109 my $log_format = $opts{log_format} || "%d %C:%L(%P) [%l]: %m%n";
110 my %subst_hash = (
111 P => $$,
112 n => "\n",
113 );
114 $log_format =~ s#%(.)#exists $subst_hash{$1} ? $subst_hash{$1} : '%'.$1#ge;
115 my $stack_trace = $opts{stack_trace};
116 my $custom_callback = $opts{callback};
117
118 my $callback = sub {
119 my %p = @_;
120 $p{message} .=
121 "\n >>>>>>>>>> StackTrace\n".
122 Carp::longmess('Begin StackTrace').
123 " <<<<<<<<<< /StackTrace"
124 if $stack_trace and $levels{$p{level}} >= $levels{warning};
125 return $custom_callback->(%p) if $custom_callback;
126
127 my ($sec, $min, $hour, $mday, $mon, $year) = localtime;
128 $subst_hash{d} = sprintf(
129 '[%02d/%02d/%02d %02d:%02d:%02d]',
130 $mday, $mon+1, $year-100, $hour, $min, $sec,
131 );
132
133 $subst_hash{m} = $p{message};
134 $subst_hash{l} = $p{level};
135
136 #Who's calling?
137 my @caller = caller(4 - ($p{_direct} || 0));
138 $subst_hash{C} = $caller[0];
139 $subst_hash{L} = $caller[2];
140
141 my $final_msg = $log_format;
142 $final_msg =~ s#%(.)#exists $subst_hash{$1} ? $subst_hash{$1} : '%'.$1#ge;
143 return $final_msg;
144 };
145
146 my $self = $this->SUPER::new(callbacks => $callback);
147
148 my $minlevel = $opts{min_level} || 'debug';
149 $self->add(
150 Log::Dispatch::Screen->new(
151 name => 'genlog',
152 min_level => $minlevel,
153 max_level => $opts{max_level} || 'emergency',
154 stderr => 1,
155 )
156 );
157 $self->cut_min_level($minlevel);
158 $instance = $self;
159 $self;
160 }
161
162 sub instance { $instance || shift->new( @_ ) }
163
164 sub cut_min_level {
165 my (undef, $minlevel) = @_;
166 my $num = $levels{$minlevel} or return;
167 my @to_cut = grep {$levels{$_} < $num} keys %levels;
168 no strict 'refs';
169 no warnings;
170 *$_ = sub {} for @to_cut;
171 *log = sub {
172 my $self = shift;
173 my %p = @_;
174 return if $levels{$p{level}} < $num;
175 $self->SUPER::log(@_, caller !~ /^Log::Dispatch/ ? (_direct => 1) : ());
176 };
177 return;
178 }
179
180 sub log { shift->SUPER::log(@_, caller !~ /^Log::Dispatch/ ? (_direct => 1) : ()) }
181
182 1;