File Coverage

blib/lib/Amphibic/Log.pm
Criterion Covered Total %
statement 2 4 50.0
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 4 6 66.6


line stmt bran cond sub pod time code
1             package Amphibic::Log;
2             BEGIN {
3 4     4   4832 $Amphibic::Log::VERSION = '0.02';
4             }
5              
6             # ABSTRACT: Because logging should be fun
7              
8 4     4   1933 use Moose;
  0            
  0            
9              
10             use Amphibic::Log::Entry;
11              
12             has 'name' => (
13             is => 'ro',
14             isa => 'Str',
15             required => 1,
16             );
17              
18             my %levels = (
19             fatal => 1,
20             error => 2,
21             warn => 3,
22             info => 4,
23             debug => 5,
24             trace => 6,
25             );
26              
27             my $log_level = $levels{ $ENV{ LOG_LEVEL } || '' } || 0;
28            
29             unless ($log_level > 0) {
30             foreach my $level (keys %levels) {
31             if ($ENV{ 'LOG_' . uc ($level) }) {
32             $log_level = $levels{ $level } if $levels{ $level } > $log_level;
33             }
34             }
35             }
36            
37             foreach my $level (qw/trace debug info warn error fatal/) {
38             if ($levels{ $level } <= $log_level) {
39             __PACKAGE__->meta->add_method ($level,sub {
40             my ($self,$message) = @_;
41              
42             my %args = (
43             facility => $self->name,
44             level => $level,
45             message => $message,
46             );
47            
48             return $self->_dispatch (Amphibic::Log::Entry->new (\%args))
49             });
50            
51             __PACKAGE__->meta->add_method ("is_$level",sub { 1 });
52             } else {
53             __PACKAGE__->meta->add_method ($level,sub {});
54            
55             __PACKAGE__->meta->add_method ("is_$level",sub { 0 });
56             }
57             }
58              
59             sub _dispatch {
60             my ($self,$entry) = @_;
61              
62             print STDERR $entry->as_string . "\n";
63            
64             return;
65             }
66              
67             __PACKAGE__->meta->make_immutable;
68              
69             1;
70              
71             __END__
72              
73             =pod
74              
75             =head1 NAME
76              
77             Amphibic::Log - Because logging should be fun
78              
79             =head1 VERSION
80              
81             version 0.02
82              
83             =head1 SYNOPSIS
84              
85             # In webapp.pl
86            
87             my $logger = Amphibic::Log->new (name => "webapp");
88            
89             $logger->info ("Authentication failure");
90            
91             # In a shell far, far away
92            
93             $ export LOG_TRACE=1
94             $ perl webapp.pl
95              
96             =head1 DESCRIPTION
97              
98             Logging should be a simple thing that everyone do. Yet, few modules if
99             any actually do logging. And many that actually do logging has
100             invented their own logging scheme. The problem isn't dependencies on
101             other modules, but the fact that most logging modules get some
102             fundamental assumptions about where they will be used wrong. This is my
103             attempt at making logging easy and not something to be avoided, even
104             when faced with real world situations like time constraints and lack
105             of planning.
106              
107             =head1 LOG LEVELS
108              
109             This module is hardcoded with six fairly standard logging levels, namely
110             "fatal", "error", "warn", "info", "debug", and "trace". This module
111             behaves so that enabling a given level in the list above also enables
112             every level before it. Ie, if you enable "trace", you also enable every
113             single other level.
114              
115             =head1 DESTINATIONS
116              
117             At the moment, only logging to STDERR is supported. Yes, this is going
118             to change, I just want to focus on getting other things right first
119             before adding support for more destinations.
120              
121             =head1 ENABLING LOGGING
122              
123             To enable logging of all messages:
124              
125             export LOG_TRACE=1
126              
127             Or if you are not using bash, use the equivalent command for setting an
128             environment variable in your shell. To enable a given level, set the
129             environment variable LOG_E<lt>levelE<gt> to a true value.
130              
131             =head1 ATTRIBUTES
132              
133             =head2 name
134              
135             Identify the component name the log messages are coming from. This
136             should be a simple identifier; If the logging entity was L<DBIx::Class>
137             then the identifier should probably be something like "dbic".
138              
139             =head1 METHODS
140              
141             =head2 is_E<lt>levelE<gt>
142              
143             # $log->is_debug;
144            
145             Returns a true value if the current logging level is at least at this
146             level. The purpose of these methods is usually so the programmer can
147             avoid running things like expensive debugging routines if it isn't
148             necessary.
149              
150             =head2 E<lt>levelE<gt>
151              
152             # $log->debug ($message);
153              
154             Sends $message to the underlying transports.
155              
156             =head1 SEE ALSO
157              
158             =over 4
159              
160             =item L<Log::Contextual>
161              
162             =back
163              
164             =head1 BUGS
165              
166             Most software has bugs. This module probably isn't an exception.
167             If you find a bug please either email me, or add the bug to cpan-RT.
168              
169             =head1 AUTHOR
170              
171             Anders Nor Berle <berle@cpan.org>
172              
173             =head1 COPYRIGHT AND LICENSE
174              
175             This software is copyright (c) 2010 by Anders Nor Berle.
176              
177             This is free software; you can redistribute it and/or modify it under
178             the same terms as the Perl 5 programming language system itself.
179              
180             =cut