File Coverage

blib/lib/Test/Smoke/LogMixin.pm
Criterion Covered Total %
statement 46 48 95.8
branch 13 14 92.8
condition 5 5 100.0
subroutine 15 15 100.0
pod 4 4 100.0
total 83 86 96.5


line stmt bran cond sub pod time code
1             package Test::Smoke::LogMixin;
2 43     43   777 use warnings;
  43         86  
  43         1444  
3 43     43   241 use strict;
  43         86  
  43         813  
4 43     43   21193 use Data::Dumper;
  43         224040  
  43         2514  
5 43     43   1831 BEGIN { $|++ }
6              
7             our $VERSION = '0.002';
8              
9 43     43   306 use Exporter 'import';
  43         158  
  43         21108  
10             our @EXPORT = qw/verbosity log_warn log_info log_debug/;
11              
12             our $USE_TIMESTAMP = 1;
13              
14             require POSIX;
15              
16             =head1 NAME
17              
18             Test::Smoke::LogMixin - "Role" that adds logging methods to "traditional" objects.
19              
20             =head1 SYNOPSIS
21              
22             package MyPackage;
23             use warnings;
24             use strict;
25             use Test::Smoke::LogMixin;
26              
27             sub new {
28             my $class = shift;
29             my %selfish = @_;
30             $selfish{_verbose} ||= 0;
31             return bless \%selfish, $class;
32             }
33             1;
34              
35             package main;
36             use MyPackage;
37             my $o = MyPackage->new(_verbose => 2);
38             $o->log_debug("This will end up in the log");
39              
40             =head1 DESCRIPTION
41              
42             This package with these mixin-methods acts like a role to extend your traditional (created with
43             C) object with 4 new methods. It has some extra
44             L logic to determine the log-level (by looking at C<<
45             $app->option('verbose') >>). For other object types it tries to fiend if there
46             are methods by the name C or C, or maybe the keys C<_verbose> or
47             C<_v> (See also L).
48              
49             The three log methods use the C way of composing strings whenever
50             more than 1 argument is passed!
51              
52             =head2 $app->verbosity
53              
54             Return the verbosity of this app.
55              
56             =head3 Arguments
57              
58             None.
59              
60             =head3 Returns
61              
62             The value of either C<_verbose> or C<_v>
63              
64             =cut
65              
66             sub verbosity {
67 2619     2619 1 4288 my $self = shift;
68 2619 100       12564 if ($self->isa('Test::Smoke::App::Base')) {
69 59         200 return $self->option('verbose');
70             }
71 2560         5039 for my $vfield (qw/verbose v/) {
72 2574 100 100     15181 return $self->$vfield if $self->can($vfield) or exists $self->{"_$vfield"};
73             }
74 0         0 my $struct = Data::Dumper->new([$self])->Terse(1)->Sortkeys(1)->Indent(1)->Dump;
75 0         0 die "Could not find a verbosity option: $struct\n";
76             }
77              
78             =head2 $app->log_warn($fmt, @values)
79              
80             C<< prinf $fmt, @values >> to the currently selected filehandle.
81              
82             =head3 Arguments
83              
84             Positional.
85              
86             =over
87              
88             =item $fmt => a (s)printf format
89              
90             The format gets an extra new line if one wasn't present.
91              
92             =item @values => optional vaules for the template.
93              
94             =back
95              
96             =head3 Returns
97              
98             use in void context.
99              
100             =head3 Exceptions
101              
102             None.
103              
104             =cut
105              
106             sub log_warn {
107 80     80 1 5914 my $self = shift;
108              
109 80         774 print _log_message(@_);
110             }
111              
112             =head2 $app->log_info($fmt, @values)
113              
114             C<< prinf $fmt, @values >> to the currently selected filehandle if the 'verbose'
115             option is set.
116              
117             =head3 Arguments
118              
119             Positional.
120              
121             =over
122              
123             =item $fmt => a (s)printf format
124              
125             The format gets an extra new line if one wasn't present.
126              
127             =item @values => optional vaules for the template.
128              
129             =back
130              
131             =head3 Returns
132              
133             use in void context.
134              
135             =head3 Exceptions
136              
137             None.
138              
139             =cut
140              
141             sub log_info {
142 1026     1026 1 4245 my $self = shift;
143 1026 100       2789 return if !$self->verbosity;
144              
145 54         283 print _log_message(@_);
146             }
147              
148             =head2 $app->log_debug($fmt, @values)
149              
150             C<< prinf $fmt, @values >> to the currently selected filehandle if the 'verbose'
151             option is set to a value > 1.
152              
153             =head3 Arguments
154              
155             Positional.
156              
157             =over
158              
159             =item $fmt => a (s)printf format
160              
161             The format gets an extra new line if one wasn't present.
162              
163             =item @values => optional vaules for the template.
164              
165             =back
166              
167             =head3 Returns
168              
169             use in void context.
170              
171             =head3 Exceptions
172              
173             None.
174              
175             =cut
176              
177             sub log_debug {
178 1593     1593 1 4370 my $self = shift;
179 1593 100       3703 return if $self->verbosity < 2;
180              
181 5         34 print _log_message(@_);
182             }
183              
184             # Compose the message to be logged.
185             sub _log_message {
186 139     139   1757 (my $fmt = shift) =~ s/\n*\z//;
187              
188 139 50       4290 my $stamp = $USE_TIMESTAMP
    100          
189             ? $^O eq 'MSWin32'
190             ? POSIX::strftime("[%Y-%m-%d %H:%M:%SZ] ", gmtime)
191             : POSIX::strftime("[%Y-%m-%d %H:%M:%S%z] ", localtime)
192             : "";
193              
194             # use the $stamp for every line.
195             # sprintf iff @_;
196 139 100       2042 my @message = split(/\n/, @_ ? sprintf("$fmt", @_) : ($fmt));
197 139         4093 return join("\n", map "$stamp$_", @message) . "\n";
198             }
199              
200             =head1 NAME
201              
202             Test::Smoke::Logger - Helper object for logging.
203              
204             =head1 SYNOPSIS
205              
206             use Test::Smoke::LogMixin;
207             my $logger = Test::Smoke::Logger->new(v => 1);
208             $logger->log_warn("Minimal log level"); # v >= 0
209             $logger->log_info("Medium log level"); # v <= 1
210             $logger->log_debug("High log level"); # v > 1
211              
212             =head1 DESCRIPTION
213              
214             =head2 Test::Smoke::Logger->new(%arguments)
215              
216             Return a logger instance.
217              
218             =head3 Arguments
219              
220             Named, hash:
221              
222             =over
223              
224             =item v => <0|1|2>
225              
226             =back
227              
228             =head3 Returns
229              
230             The L instance.
231              
232             =cut
233              
234             package Test::Smoke::Logger;
235 43     43   363 use warnings;
  43         100  
  43         1645  
236 43     43   294 use strict;
  43         120  
  43         1316  
237 43     43   235 use base 'Test::Smoke::ObjectBase';
  43         100  
  43         16858  
238 43     43   348 use Test::Smoke::LogMixin;
  43         91  
  43         4967  
239             Test::Smoke::LogMixin->import();
240              
241             sub new {
242 115     115   1281 my $class = shift;
243 115         689 my %raw = @_;
244 115   100     1030 my $self = { _verbose => $raw{v} || 0 };
245 115         966 return bless $self, $class;
246             }
247              
248             1;
249              
250             =head1 COPYRIGHT
251              
252             (c) 2020, All rights reserved.
253              
254             * Abe Timmerman
255              
256             This library is free software; you can redistribute it and/or modify
257             it under the same terms as Perl itself.
258              
259             See:
260              
261             * ,
262             *
263              
264             This program is distributed in the hope that it will be useful,
265             but WITHOUT ANY WARRANTY; without even the implied warranty of
266             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
267              
268             =cut