File Coverage

blib/lib/WWW/Domain/Registry/Joker/Loggish.pm
Criterion Covered Total %
statement 14 35 40.0
branch 0 8 0.0
condition 0 6 0.0
subroutine 5 10 50.0
pod 5 5 100.0
total 24 64 37.5


line stmt bran cond sub pod time code
1             package WWW::Domain::Registry::Joker::Loggish;
2              
3 1     1   14 use 5.006;
  1         2  
4 1     1   3 use strict;
  1         1  
  1         15  
5 1     1   3 use warnings;
  1         1  
  1         18  
6              
7 1     1   423 use Log::Dispatch;
  1         9516  
  1         30  
8 1     1   368 use Log::Dispatch::Screen;
  1         13965  
  1         272  
9              
10             our $VERSION = '0.02';
11              
12             =head1 NAME
13              
14             WWW::Domain::Registry::Joker::Loggish - a simple logging helper
15              
16             =head1 SYNOPSIS
17              
18             use WWW::Domain::Registry::Joker::Loggish;
19              
20             @ISA = qw/WWW::Domain::Registry::Joker::Loggish/;
21              
22             $self = WWW::Domain::Registry::Joker::Loggish::new($proto,
23             'debug' => 1);
24              
25             $self->debug('Diagnostics for the masses');
26             $self->error('Nobody loves me!');
27              
28             $self->log('notice', 'Something important is about to happen');
29             $self->log('debug', 'Nobody ever bothers to read those...');
30              
31             =head1 DESCRIPTION
32              
33             The C class provides a simple
34             logging interface, implemented using the C module.
35             It is meant to serve as a parent class providing the C, C,
36             and C methods so that other classes do not have to worry about
37             implementing them.
38              
39             =head1 METHODS
40              
41             The C class provides the following
42             methods:
43              
44             =over 4
45              
46             =item * new ( PARAMS )
47              
48             Create a new C object with
49             the specified parameters:
50              
51             =over 4
52              
53             =item * debug
54              
55             A boolean flag for the output of diagnostic messages - should the C
56             method actually display the message passed or simply ignore it.
57              
58             =item * log
59              
60             The C object to use for the output; if not passed,
61             a new object will be created at first use - see the C method
62             below.
63              
64             =back
65              
66             =cut
67              
68             sub new($ %)
69             {
70 0     0 1   my ($proto, %param) = @_;
71 0   0       my $class = ref $proto || $proto;
72 0           my $self;
73              
74 0           $self = {
75             'debug' => 0,
76             'log' => undef,
77             %param,
78             };
79 0           bless $self, $class;
80 0           return $self;
81             }
82              
83             =item * logger ( [OBJECT] )
84              
85             Get or set the C object used for the actual logging.
86              
87             If no object is specified and no logging object has been set yet, this
88             method will create a C object and a C
89             destination set to output to the standard error stream. If tis does not
90             suit the needs of the application, it should invoke the C method
91             and pass its own C handler. This may also be done at
92             object creation time by passing the C parameter to the C
93             method.
94              
95             =cut
96              
97             sub logger($ $)
98             {
99 0     0 1   my ($self, $log) = @_;
100              
101 0 0         if (defined($log)) {
    0          
102 0 0 0       if (index(ref($log), '::') == -1 ||
103             !$log->isa('Log::Dispatch')) {
104 0           die("Not a Log::Dispatch object: '".ref($log)."'");
105             }
106 0           $self->{'log'} = $log;
107             } elsif (!defined($self->{'log'})) {
108 0           $log = new Log::Dispatch();
109             $log->add(new Log::Dispatch::Screen('name' => 'STDERR',
110 0 0         'min_level' => ($self->{'debug'}? 'debug': 'info')));
111 0           $self->{'log'} = $log;
112             }
113 0           return $self->{'log'};
114             }
115              
116             =item * log ( LEVEL, MESSAGE )
117              
118             Log the specified message at the specified level.
119              
120             This method invokes the C method, so that a C
121             object will be created automatically at first use if none has been
122             specified.
123              
124             =cut
125              
126             sub log($ $ $)
127             {
128 0     0 1   my ($self, $level, $msg) = @_;
129              
130 0           $self->logger()->log('level' => $level, 'message' => "$msg\n");
131             }
132              
133             =item * debug ( MESSAGE )
134              
135             Log a message with a priority of 'debug' using the C method.
136             Note that whether the message will actually be logged or not will
137             depend on the setting of the C property at object creation time.
138              
139             =cut
140              
141             sub debug($ $)
142             {
143 0     0 1   my ($self, $msg) = @_;
144              
145 0           $self->log('debug', $msg);
146             }
147              
148             =item * error ( MESSAGE )
149              
150             Log a message with a priority of 'error' using the C method.
151              
152             =cut
153              
154             sub error($ $)
155             {
156 0     0 1   my ($self, $msg) = @_;
157              
158 0           $self->log('error', $msg);
159             }
160              
161             =back
162              
163             =head1 SEE ALSO
164              
165             L
166              
167             =head1 BUGS
168              
169             =over 4
170              
171             =item *
172              
173             Maybe there ought to be a way to toggle the display of diagnostic
174             messages after the object has been created.
175              
176             =back
177              
178             =head1 HISTORY
179              
180             The C class was written by
181             Peter Pentchev in 2007.
182              
183             =head1 AUTHOR
184              
185             Peter Pentchev, Eroam@ringlet.netE
186              
187             =head1 COPYRIGHT AND LICENSE
188              
189             Copyright (C) 2007 by Peter Pentchev
190              
191             This library is free software; you can redistribute it and/or modify
192             it under the same terms as Perl itself, either Perl version 5.8.8 or,
193             at your option, any later version of Perl 5 you may have available.
194              
195             =cut
196              
197             1;