Commit | Line | Data |
0daa11f3 |
1 | package Log::Contextual; |
2 | |
2033c911 |
3 | use 5.006; |
4 | |
5 | $VERSION = '1.000'; |
6 | |
7 | require Exporter; |
8 | |
9 | BEGIN { @ISA = qw(Exporter) } |
10 | |
11 | @EXPORT = qw(set_logger log_debug with_logger); |
12 | |
7cec609c |
13 | our $Get_Logger; |
14 | |
2daff231 |
15 | sub set_logger (&) { |
7cec609c |
16 | $Get_Logger = $_[0]; |
17 | } |
18 | |
80c3e48b |
19 | sub with_logger (&&) { |
20 | local $Get_Logger = $_[0]; |
21 | $_[1]->(); |
2daff231 |
22 | } |
23 | |
6dc6632a |
24 | sub log_trace (&) { |
25 | my $log = $Get_Logger->(); |
26 | $log->trace($_[0]->()) |
27 | if $log->is_trace; |
28 | } |
29 | |
7cec609c |
30 | sub log_debug (&) { |
31 | my $log = $Get_Logger->(); |
32 | $log->debug($_[0]->()) |
33 | if $log->is_debug; |
34 | } |
35 | |
6dc6632a |
36 | sub log_info (&) { |
37 | my $log = $Get_Logger->(); |
38 | $log->info($_[0]->()) |
39 | if $log->is_info; |
40 | } |
41 | |
42 | sub log_warn (&) { |
43 | my $log = $Get_Logger->(); |
44 | $log->warn($_[0]->()) |
45 | if $log->is_warn; |
46 | } |
47 | |
48 | sub log_error (&) { |
49 | my $log = $Get_Logger->(); |
50 | $log->error($_[0]->()) |
51 | if $log->is_error; |
52 | } |
53 | |
54 | sub log_fatal (&) { |
55 | my $log = $Get_Logger->(); |
56 | $log->fatal($_[0]->()) |
57 | if $log->is_fatal; |
58 | } |
59 | |
0daa11f3 |
60 | 1; |
0a3750e2 |
61 | |
62 | __END__ |
63 | |
2daff231 |
64 | =head1 NAME |
65 | |
66 | Log::Contextual - Super simple logging interface |
67 | |
68 | =head1 SYNOPSIS |
69 | |
70 | use Log::Contextual; |
71 | |
72 | my $logger = WarnLogger->new; |
73 | my $logger2 = FileLogger->new; |
74 | |
75 | set_logger { $logger }; |
76 | |
77 | log_debug { "program started" }; |
78 | |
79 | sub foo { |
80 | with_logger { |
81 | log_trace { "foo entered" }; |
82 | # ... |
83 | log_trace { "foo left" }; |
84 | } $logger2; |
85 | } |
86 | |
87 | =head1 DESCRIPTION |
88 | |
89 | This module is for simplistic but very extensible logging. |
90 | |
91 | =head1 FUNCTIONS |
92 | |
93 | =head2 set_logger |
94 | |
95 | my $logger = WarnLogger->new; |
96 | set_logger { $logger }; |
97 | |
98 | Arguments: CodeRef $returning_logger |
99 | |
100 | =head2 with_logger |
101 | |
102 | my $logger = WarnLogger->new; |
80c3e48b |
103 | with_logger { $logger } sub { |
2daff231 |
104 | if (1 == 0) { |
105 | log_fatal { 'Non Logical Universe Detected' }; |
106 | } else { |
107 | log_info { 'All is good' }; |
108 | } |
80c3e48b |
109 | }; |
2daff231 |
110 | |
111 | Arguments: CodeRef $to_execute, CodeRef $returning_logger |
112 | |
113 | =head2 log_trace |
114 | |
115 | log_trace { 'entered method foo with args ' join q{,}, @args }; |
116 | |
117 | Arguments: CodeRef $returning_message |
118 | |
119 | =head2 log_debug |
120 | |
121 | log_debug { 'entered method foo' }; |
122 | |
123 | Arguments: CodeRef $returning_message |
124 | |
125 | =head2 log_info |
126 | |
127 | log_info { 'started process foo' }; |
128 | |
129 | Arguments: CodeRef $returning_message |
130 | |
131 | =head2 log_warn |
132 | |
133 | log_warn { 'possible misconfiguration at line 10' }; |
134 | |
135 | Arguments: CodeRef $returning_message |
136 | |
137 | =head2 log_error |
138 | |
139 | log_error { 'non-numeric user input!' }; |
140 | |
141 | Arguments: CodeRef $returning_message |
142 | |
143 | =head2 log_fatal |
144 | |
145 | log_fatal { '1 is never equal to 0!' }; |
146 | |
147 | Arguments: CodeRef $returning_message |
148 | |
149 | =head1 SUGARY SYNTAX |
150 | |
151 | This package also provides: |
152 | |
153 | L<Log::Contextual::Sugar> - provides Dlog_$level and DlogS_$level convenience |
154 | functions |
155 | |
156 | =head1 AUTHOR |
157 | |
158 | frew - Arthur Axel "fREW" Schmidt <frioux@gmail.com> |
159 | |
160 | =head1 DESIGNER |
161 | |
162 | mst - Matt S. Trout <mst@shadowcat.co.uk> |
163 | |
164 | =head1 COPYRIGHT |
165 | |
166 | Copyright (c) 2010 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed |
167 | above. |
168 | |
169 | =head1 LICENSE |
170 | |
171 | This library is free software and may be distributed under the same terms as |
172 | Perl 5 itself. |
173 | |
174 | =cut |
175 | |
0a3750e2 |
176 | .:13:03:05:. <@mst> amazing how simple this stuff is once you get the paradigm |
177 | .:13:03:13:. <@mst> also consider |
178 | .:13:04:17:. <@mst> package Catalyst::Plugin::LogContextual; use Moose::Role; around |
179 | handle_request => sub { my ($orig, $self) = (shift, shift); my @args = @_; |
180 | with_logger { $self->log } sub { $self->$orig(@args) } }; |