File Coverage

blib/lib/WWW/Domain/Registry/Joker/Loggish.pm
Criterion Covered Total %
statement 15 36 41.6
branch 0 8 0.0
condition 0 6 0.0
subroutine 5 10 50.0
pod 5 5 100.0
total 25 65 38.4


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