Commit | Line | Data |
fc7ec1d9 |
1 | package Catalyst::Log; |
2 | |
3 | use strict; |
4 | use base 'Class::Accessor::Fast'; |
9b2bc37b |
5 | use Data::Dumper; |
6 | |
846772b7 |
7 | our @levels = qw[ debug info warn error fatal ]; |
8 | |
9 | { |
10 | no strict 'refs'; |
11 | |
12 | for ( my $i = 0 ; $i < @levels ; $i++ ) { |
13 | |
14 | my $name = $levels[$i]; |
15 | my $level = 1 << $i; |
16 | |
17 | *{$name} = sub { |
18 | my $self = shift; |
19 | |
20 | if ( $self->{level} & $level ) { |
21 | $self->_log( $name, @_ ); |
22 | } |
23 | }; |
24 | |
25 | *{"is_$name"} = sub { |
26 | my $self = shift; |
27 | |
28 | if (@_) { |
29 | if ( $_[0] ) { |
30 | $self->{level} |= $level; |
31 | } |
32 | else { |
33 | $self->{level} &= ~$level; |
34 | } |
35 | } |
36 | return $self->{level} & $level; |
37 | }; |
38 | } |
39 | |
40 | *new = sub { bless( { level => ( 1 << @levels ) - 1 }, shift ) } |
41 | } |
42 | |
43 | sub _dump { |
44 | my $self = shift; |
45 | local $Data::Dumper::Terse = 1; |
46 | $self->info( Dumper( $_[0] ) ); |
47 | } |
48 | |
49 | sub _log { |
50 | my $self = shift; |
51 | my $level = shift; |
52 | my $time = localtime(time); |
53 | my $message = join( "\n", @_ ); |
54 | printf( STDERR "[%s] [catalyst] [%s] %s\n", $time, $level, $message ); |
55 | } |
56 | |
57 | 1; |
58 | |
59 | __END__ |
fc7ec1d9 |
60 | |
61 | =head1 NAME |
62 | |
63 | Catalyst::Log - Catalyst Log Class |
64 | |
65 | =head1 SYNOPSIS |
66 | |
82d2fcbe |
67 | $log = $c->log; |
846772b7 |
68 | $log->debug($message); |
69 | $log->info($message); |
70 | $log->warn($message); |
71 | $log->error($message); |
72 | $log->fatal($message); |
73 | |
f4dbb0d9 |
74 | $log->is_debug; # true if debug messages is enabled |
846772b7 |
75 | $log->is_info; # true if info messages is enabled |
76 | $log->is_warn; # true if warn messages is enabled |
77 | $log->is_error; # true if error messages is enabled |
78 | $log->is_fatal; # true if fatal messages is enabled |
79 | |
f4dbb0d9 |
80 | if ( $log->is_debug ) { |
846772b7 |
81 | # expensive debugging |
82 | } |
82d2fcbe |
83 | |
fc7ec1d9 |
84 | See L<Catalyst>. |
85 | |
86 | =head1 DESCRIPTION |
87 | |
61b1e958 |
88 | This module provides the default, simple logging functionality for |
89 | Catalyst. |
90 | If you want something different set C<$c->log> in your application |
91 | module, e.g.: |
82d2fcbe |
92 | |
93 | $c->log( MyLogger->new ); |
94 | |
95 | Your logging object is expected to provide the interface described here. |
96 | |
fc7ec1d9 |
97 | |
b22c6668 |
98 | =head1 METHODS |
fc7ec1d9 |
99 | |
b22c6668 |
100 | =over 4 |
fc7ec1d9 |
101 | |
846772b7 |
102 | =item $log->debug($message) |
b22c6668 |
103 | |
104 | Logs a debugging message. |
fc7ec1d9 |
105 | |
846772b7 |
106 | =item $log->error($message) |
fc7ec1d9 |
107 | |
b22c6668 |
108 | Logs an error message. |
fc7ec1d9 |
109 | |
846772b7 |
110 | =item $log->info($message) |
fc7ec1d9 |
111 | |
b22c6668 |
112 | Logs an informational message. |
fc7ec1d9 |
113 | |
846772b7 |
114 | =item $log->warn($message) |
fc7ec1d9 |
115 | |
b22c6668 |
116 | Logs a warning message. |
fc7ec1d9 |
117 | |
b22c6668 |
118 | =back |
119 | |
fc7ec1d9 |
120 | =head1 SEE ALSO |
121 | |
122 | L<Catalyst>. |
123 | |
124 | =head1 AUTHOR |
125 | |
126 | Sebastian Riedel, C<sri@cpan.org> |
61b1e958 |
127 | Marcus Ramberg, C<mramberg@cpan.org> |
fc7ec1d9 |
128 | |
129 | =head1 COPYRIGHT |
130 | |
61b1e958 |
131 | This program is free software, you can redistribute it and/or modify |
132 | it under the same terms as Perl itself. |
fc7ec1d9 |
133 | |
134 | =cut |
135 | |
136 | 1; |