File Coverage

blib/lib/Venus/Log.pm
Criterion Covered Total %
statement 67 79 84.8
branch 23 34 67.6
condition 26 42 61.9
subroutine 20 23 86.9
pod 10 15 66.6
total 146 193 75.6


line stmt bran cond sub pod time code
1             package Venus::Log;
2              
3 3     3   601 use 5.018;
  3         11  
4              
5 3     3   17 use strict;
  3         14  
  3         73  
6 3     3   14 use warnings;
  3         11  
  3         102  
7              
8 3     3   19 use Venus::Class 'attr', 'base', 'with';
  3         6  
  3         19  
9              
10             base 'Venus::Kind::Utility';
11              
12             with 'Venus::Role::Buildable';
13              
14             # ATTRIBUTES
15              
16             attr 'handler';
17             attr 'level';
18             attr 'separator';
19              
20             # STATE
21              
22             state $NAME = {trace => 1, debug => 2, info => 3, warn => 4, error => 5, fatal => 6};
23             state $CODE = {reverse %$NAME};
24              
25             # BUILDERS
26              
27             sub build_arg {
28 2     2 0 8 my ($self, $data) = @_;
29              
30             return {
31 2         10 level => $data,
32             };
33             }
34              
35             sub build_self {
36 54     54 0 170 my ($self, $data) = @_;
37              
38 54   66     215 $self->level($self->level_name($self->level) || $self->level_name(1));
39 54 100   0   282 $self->handler(sub{shift; CORE::print(STDOUT @_, "\n")}) if !$self->handler;
  0         0  
  0         0  
40 54 50       212 $self->separator(" ") if !$self->separator;
41              
42 54         117 return $self;
43             }
44              
45             # METHODS
46              
47             sub commit {
48 26     26 0 75 my ($self, $level, @args) = @_;
49              
50 26         86 my $req_level = $self->level_code($level);
51 26         92 my $set_level = $self->level_code($self->level);
52              
53 26 100 100     328 return ($req_level && $set_level && ($req_level >= $set_level))
54             ? $self->write($level, $self->output($self->input(@args)))
55             : $self;
56             }
57              
58             sub debug {
59 3     3 1 23 my ($self, @args) = @_;
60              
61 3         20 return $self->commit('debug', @args);
62             }
63              
64             sub error {
65 6     6 1 22 my ($self, @args) = @_;
66              
67 6         25 return $self->commit('error', @args);
68             }
69              
70             sub fatal {
71 3     3 1 11 my ($self, @args) = @_;
72              
73 3         10 return $self->commit('fatal', @args);
74             }
75              
76             sub info {
77 7     7 1 30 my ($self, @args) = @_;
78              
79 7         28 return $self->commit('info', @args);
80             }
81              
82             sub input {
83 21     21 1 71 my ($self, @args) = @_;
84              
85 21         118 return (@args);
86             }
87              
88             sub level_code {
89 52     52 0 103 my ($self, $data) = @_;
90              
91 52 50       161 $data = $data ? lc $data : $self->level;
92              
93 52 50       130 return undef if !defined $data;
94              
95 52   66     220 return $$NAME{$data} || ($$CODE{$data} && $$NAME{$$CODE{$data}});
96             }
97              
98             sub level_name {
99 78     78 0 178 my ($self, $data) = @_;
100              
101 78 100       216 $data = $data ? lc $data : $self->level;
102              
103 78 100       278 return undef if !defined $data;
104              
105 54   66     503 return $$CODE{$data} || ($$NAME{$data} && $$CODE{$$NAME{$data}});
106             }
107              
108             sub output {
109 21     21 1 90 my ($self, @args) = @_;
110              
111 21         60 return (join $self->separator, map $self->string($_), @args);
112             }
113              
114             sub string {
115 40     40 1 115 my ($self, $data) = @_;
116              
117 40         195 require Scalar::Util;
118              
119 40 100       121 if (!defined $data) {
120 1         5 return '';
121             }
122              
123 39         99 my $blessed = Scalar::Util::blessed($data);
124 39   33     126 my $isvenus = $blessed && $data->isa('Venus::Core') && $data->can('does');
125              
126 39 100 100     139 if (!$blessed && !ref $data) {
127 37         197 return $data;
128             }
129 2 50 66     14 if ($blessed && ref($data) eq 'Regexp') {
130 0         0 return "$data";
131             }
132 2 50 33     8 if ($isvenus && $data->does('Venus::Role::Explainable')) {
133 0     0   0 return $self->dump(sub{$data->explain});
  0         0  
134             }
135 2 50 33     7 if ($isvenus && $data->does('Venus::Role::Valuable')) {
136 0     0   0 return $self->dump(sub{$data->value});
  0         0  
137             }
138 2 50 33     8 if ($isvenus && $data->does('Venus::Role::Dumpable')) {
139 0         0 return $data->dump;
140             }
141 2 50 66     11 if ($blessed && overload::Method($data, '""')) {
142 0         0 return "$data";
143             }
144 2 50 66     87 if ($blessed && $data->can('as_string')) {
145 0         0 return $data->as_string;
146             }
147 2 50 66     15 if ($blessed && $data->can('to_string')) {
148 0         0 return $data->to_string;
149             }
150 2 50 66     20 if ($blessed && $data->isa('Venus::Kind')) {
151 0         0 return $data->stringified;
152             }
153             else {
154 2     2   28 return $self->dump(sub{$data});
  2         17  
155             }
156             }
157              
158             sub trace {
159 4     4 1 20 my ($self, @args) = @_;
160              
161 4         25 return $self->commit('trace', @args);
162             }
163              
164             sub warn {
165 3     3 1 13 my ($self, @args) = @_;
166              
167 3         13 return $self->commit('warn', @args);
168             }
169              
170             sub write {
171 22     22 1 74 my ($self, $level, @args) = @_;
172              
173 22         75 $self->handler->($level, @args);
174              
175 22         238 return $self;
176             }
177              
178             1;
179              
180              
181              
182             =head1 NAME
183              
184             Venus::Log - Log Class
185              
186             =cut
187              
188             =head1 ABSTRACT
189              
190             Log Class for Perl 5
191              
192             =cut
193              
194             =head1 SYNOPSIS
195              
196             package main;
197              
198             use Venus::Log;
199              
200             my $log = Venus::Log->new;
201              
202             # $log->trace(time, 'Something failed!');
203              
204             # "0000000000 Something failed!"
205              
206             # $log->error(time, 'Something failed!');
207              
208             # "0000000000 Something failed!"
209              
210             =cut
211              
212             =head1 DESCRIPTION
213              
214             This package provides methods for logging information using various log levels.
215             The default log level is L. Acceptable log levels are C,
216             C, C, C, C, and C, and the set log level will
217             handle events for its level and any preceding levels in the order specified.
218              
219             =cut
220              
221             =head1 ATTRIBUTES
222              
223             This package has the following attributes:
224              
225             =cut
226              
227             =head2 handler
228              
229             handler(coderef $code) (coderef)
230              
231             The handler attribute holds the callback that handles logging. The handler is
232             passed the log level and the log messages.
233              
234             I>
235              
236             =over 4
237              
238             =item handler example 1
239              
240             # given: synopsis
241              
242             package main;
243              
244             my $handler = $log->handler;
245              
246             my $events = [];
247              
248             $handler = $log->handler(sub{shift; push @$events, [@_]});
249              
250             =back
251              
252             =cut
253              
254             =head2 level
255              
256             level(string $name) (string)
257              
258             The level attribute holds the current log level. Valid log levels are C,
259             C, C, C, C and C, and will emit log messages
260             in that order. Invalid log levels effectively disable logging.
261              
262             I>
263              
264             =over 4
265              
266             =item level example 1
267              
268             # given: synopsis
269              
270             package main;
271              
272             my $level = $log->level;
273              
274             # "trace"
275              
276             $level = $log->level('fatal');
277              
278             # "fatal"
279              
280             =back
281              
282             =cut
283              
284             =head2 separator
285              
286             separator(any $data) (any)
287              
288             The separator attribute holds the value used to join multiple log message arguments.
289              
290             I>
291              
292             =over 4
293              
294             =item separator example 1
295              
296             # given: synopsis
297              
298             package main;
299              
300             my $separator = $log->separator;
301              
302             # ""
303              
304             $separator = $log->separator("\n");
305              
306             # "\n"
307              
308             =back
309              
310             =cut
311              
312             =head1 INHERITS
313              
314             This package inherits behaviors from:
315              
316             L
317              
318             =cut
319              
320             =head1 INTEGRATES
321              
322             This package integrates behaviors from:
323              
324             L
325              
326             =cut
327              
328             =head1 METHODS
329              
330             This package provides the following methods:
331              
332             =cut
333              
334             =head2 debug
335              
336             debug(string @data) (Venus::Log)
337              
338             The debug method logs C information and returns the invocant.
339              
340             I>
341              
342             =over 4
343              
344             =item debug example 1
345              
346             # given: synopsis
347              
348             package main;
349              
350             # $log = $log->debug(time, 'Something failed!');
351              
352             # "0000000000 Something failed!"
353              
354             =back
355              
356             =over 4
357              
358             =item debug example 2
359              
360             # given: synopsis
361              
362             package main;
363              
364             # $log->level('info');
365              
366             # $log = $log->debug(time, 'Something failed!');
367              
368             # noop
369              
370             =back
371              
372             =cut
373              
374             =head2 error
375              
376             error(string @data) (Venus::Log)
377              
378             The error method logs C information and returns the invocant.
379              
380             I>
381              
382             =over 4
383              
384             =item error example 1
385              
386             # given: synopsis
387              
388             package main;
389              
390             # $log = $log->error(time, 'Something failed!');
391              
392             # "0000000000 Something failed!"
393              
394             =back
395              
396             =over 4
397              
398             =item error example 2
399              
400             # given: synopsis
401              
402             package main;
403              
404             # $log->level('fatal');
405              
406             # $log = $log->error(time, 'Something failed!');
407              
408             # noop
409              
410             =back
411              
412             =cut
413              
414             =head2 fatal
415              
416             fatal(string @data) (Venus::Log)
417              
418             The fatal method logs C information and returns the invocant.
419              
420             I>
421              
422             =over 4
423              
424             =item fatal example 1
425              
426             # given: synopsis
427              
428             package main;
429              
430             # $log = $log->fatal(time, 'Something failed!');
431              
432             # "0000000000 Something failed!"
433              
434             =back
435              
436             =over 4
437              
438             =item fatal example 2
439              
440             # given: synopsis
441              
442             package main;
443              
444             # $log->level('unknown');
445              
446             # $log = $log->fatal(time, 'Something failed!');
447              
448             # noop
449              
450             =back
451              
452             =cut
453              
454             =head2 info
455              
456             info(string @data) (Venus::Log)
457              
458             The info method logs C information and returns the invocant.
459              
460             I>
461              
462             =over 4
463              
464             =item info example 1
465              
466             # given: synopsis
467              
468             package main;
469              
470             # $log = $log->info(time, 'Something failed!');
471              
472             # "0000000000 Something failed!"
473              
474             =back
475              
476             =over 4
477              
478             =item info example 2
479              
480             # given: synopsis
481              
482             package main;
483              
484             # $log->level('warn');
485              
486             # $log = $log->info(time, 'Something failed!');
487              
488             # noop
489              
490             =back
491              
492             =cut
493              
494             =head2 input
495              
496             input(string @data) (string)
497              
498             The input method returns the arguments provided to the log level methods, to
499             the L, and can be overridden by subclasses.
500              
501             I>
502              
503             =over 4
504              
505             =item input example 1
506              
507             # given: synopsis
508              
509             package main;
510              
511             my @input = $log->input(1, 'Something failed!');
512              
513             # (1, 'Something failed!')
514              
515             =back
516              
517             =cut
518              
519             =head2 output
520              
521             output(string @data) (string)
522              
523             The output method returns the arguments returned by the L method, to
524             the log handler, and can be overridden by subclasses.
525              
526             I>
527              
528             =over 4
529              
530             =item output example 1
531              
532             # given: synopsis
533              
534             package main;
535              
536             my $output = $log->output(time, 'Something failed!');
537              
538             # "0000000000 Something failed!"
539              
540             =back
541              
542             =cut
543              
544             =head2 string
545              
546             string(any $data) (string)
547              
548             The string method returns a stringified representation of any argument provided
549             and is used by the L method.
550              
551             I>
552              
553             =over 4
554              
555             =item string example 1
556              
557             # given: synopsis
558              
559             package main;
560              
561             my $string = $log->string;
562              
563             # ""
564              
565             =back
566              
567             =over 4
568              
569             =item string example 2
570              
571             # given: synopsis
572              
573             package main;
574              
575             my $string = $log->string('Something failed!');
576              
577             # "Something failed!"
578              
579             =back
580              
581             =over 4
582              
583             =item string example 3
584              
585             # given: synopsis
586              
587             package main;
588              
589             my $string = $log->string([1,2,3]);
590              
591             # [1,2,3]
592              
593             =back
594              
595             =over 4
596              
597             =item string example 4
598              
599             # given: synopsis
600              
601             package main;
602              
603             my $string = $log->string(bless({}));
604              
605             # "bless({}, 'main')"
606              
607             =back
608              
609             =cut
610              
611             =head2 trace
612              
613             trace(string @data) (Venus::Log)
614              
615             The trace method logs C information and returns the invocant.
616              
617             I>
618              
619             =over 4
620              
621             =item trace example 1
622              
623             # given: synopsis
624              
625             package main;
626              
627             # $log = $log->trace(time, 'Something failed!');
628              
629             # "0000000000 Something failed!"
630              
631             =back
632              
633             =over 4
634              
635             =item trace example 2
636              
637             # given: synopsis
638              
639             package main;
640              
641             # $log->level('debug');
642              
643             # $log = $log->trace(time, 'Something failed!');
644              
645             # noop
646              
647             =back
648              
649             =cut
650              
651             =head2 warn
652              
653             warn(string @data) (Venus::Log)
654              
655             The warn method logs C information and returns the invocant.
656              
657             I>
658              
659             =over 4
660              
661             =item warn example 1
662              
663             # given: synopsis
664              
665             package main;
666              
667             # $log = $log->warn(time, 'Something failed!');
668              
669             # "0000000000 Something failed!"
670              
671             =back
672              
673             =over 4
674              
675             =item warn example 2
676              
677             # given: synopsis
678              
679             package main;
680              
681             # $log->level('error');
682              
683             # $log = $log->warn(time, 'Something failed!');
684              
685             # noop
686              
687             =back
688              
689             =cut
690              
691             =head2 write
692              
693             write(string $level, any @data) (Venus::Log)
694              
695             The write method invokes the log handler, i.e. L, and returns the invocant.
696              
697             I>
698              
699             =over 4
700              
701             =item write example 1
702              
703             # given: synopsis
704              
705             package main;
706              
707             # $log = $log->write('info', time, 'Something failed!');
708              
709             # bless(..., "Venus::Log")
710              
711             =back
712              
713             =cut
714              
715             =head1 AUTHORS
716              
717             Awncorp, C
718              
719             =cut
720              
721             =head1 LICENSE
722              
723             Copyright (C) 2000, Awncorp, C.
724              
725             This program is free software, you can redistribute it and/or modify it under
726             the terms of the Apache license version 2.0.
727              
728             =cut