File Coverage

blib/lib/Mnet/Log/Conditional.pm
Criterion Covered Total %
statement 22 63 34.9
branch 2 24 8.3
condition 1 12 8.3
subroutine 7 16 43.7
pod 9 11 81.8
total 41 126 32.5


line stmt bran cond sub pod time code
1             package Mnet::Log::Conditional;
2              
3             =head1 NAME
4              
5             Mnet::Log::Conditional - Use Mnet::Log if Mnet::Log is loaded
6              
7             =head1 SYNOPSIS
8              
9             use Mnet::Log::Conditional qw( DEBUG INFO WARN FATAL );
10              
11             # nothing will happen unless Mnet::Log was loaded
12             INFO("starting");
13              
14             # errors will still always go to stderr
15             WARN("error");
16             FATAL("abort");
17              
18             my $log = Mnet::Log::Conditional->new($opts);
19             $log->DEBUG("object oriented interace");
20              
21             =head1 DESCRIPTION
22              
23             Mnet::Log::Conditional can be called to output log entries only if the
24             L module has already been otherwise loaded.
25              
26             This is used by other L modules for logging, so that they generate
27             log output only if the calling script is using the L module. Users
28             who create custom modules may want to do the same thing.
29              
30             Refer to L for more information.
31              
32             =head1 METHODS
33              
34             Mnet::Log::Conditional implements the methods listed below.
35              
36             =cut
37              
38             # required modules
39             # modules below can't import from this module due to Exporter catch-22,
40             # symbols aren't available for export until import has a chance to run,
41             # workaround is call with path, example: Mnet::Log::Conditional::INFO()
42 1     1   445 use warnings;
  1         2  
  1         31  
43 1     1   5 use strict;
  1         2  
  1         22  
44 1     1   4 use Carp;
  1         1  
  1         122  
45 1     1   7 use Exporter qw( import );
  1         2  
  1         42  
46 1     1   453 use Mnet::Opts::Cli::Cache;
  1         2  
  1         1012  
47              
48             # export function names
49             our @EXPORT_OK = qw( DEBUG INFO NOTICE WARN FATAL );
50              
51              
52              
53             sub new {
54              
55             =head2 new
56              
57             $log = Mnet::Log::Conditional->new(\%opts)
58              
59             This class method creates a new Mnet::Log::Conditional object. The opts hash
60             ref argument is not requried but may be used to override any parsed cli options
61             parsed with the L module.
62              
63             The returned object may be used to call other documented functions and methods
64             in this module, which will call the L module if it is loaded.
65              
66             Refer to the new method in perldoc L for more information.
67              
68             =cut
69              
70             # read input class and options hash ref merged with cli options
71 0   0 0 1 0 my $class = shift // croak("missing class arg");
72 0   0     0 my $opts = Mnet::Opts::Cli::Cache::get(shift // {});
73              
74             # warn if log_id contains non-space characters
75             croak("invalid log_id $opts->{log_id}")
76 0 0 0     0 if defined $opts->{log_id} and $opts->{log_id} !~ /^\S+$/;
77              
78             # create log object from options object
79 0         0 my $self = bless $opts, $class;
80              
81             # finished new method
82 0         0 return $self;
83             }
84              
85              
86              
87             sub debug {
88              
89             =head2 debug
90              
91             $log->debug($text)
92              
93             Output a debug entry using the L module, if loaed.
94              
95             =cut
96              
97             # call Mnet::Log::output if loaded or return
98 56     56 1 98 my ($self, $text) = (shift, shift);
99             return Mnet::Log::output($self, "dbg", 7, scalar(caller), $text)
100 56 50       111 if $INC{"Mnet/Log.pm"};
101 56         101 return 1;
102             }
103              
104              
105              
106             sub info {
107              
108             =head2 info
109              
110             $log->info($text)
111              
112             Output an info entry using the L module, if loaed.
113              
114             =cut
115              
116             # call Mnet::Log::output if loaded or return
117 0     0 1 0 my ($self, $text) = (shift, shift);
118             return Mnet::Log::output($self, "inf", 6, scalar(caller), $text)
119 0 0       0 if $INC{"Mnet/Log.pm"};
120 0         0 return 1;
121             }
122              
123              
124              
125             sub notice {
126              
127             # $self->notice($text)
128             # purpose: output notice using Mnet::Log if loaded, otherwise nothing happens
129              
130             # call Mnet::Log::output if loaded or return;
131 0     0 0 0 my ($self, $text) = (shift, shift);
132             return Mnet::Log::output($self, "---", 5, scalar(caller), $text)
133 0 0       0 if $INC{"Mnet/Log.pm"};
134 0         0 return 1;
135             }
136              
137              
138              
139             sub warn {
140              
141             =head2 warn
142              
143             $log->warn($text)
144              
145             Output a warn entry using the L module, if loaed.
146              
147             =cut
148              
149             # call Mnet::Log::output if loaded or warn
150 0     0 1 0 my ($self, $text) = (shift, shift);
151 0 0       0 if ($INC{"Mnet/Log.pm"}) {
152 0         0 Mnet::Log::output($self, "WRN", 4, scalar(caller), $text);
153             } else {
154 0         0 $text =~ s/\n*$//;
155 0   0     0 my $log_id = $self->{log_id} // "-";
156 0         0 CORE::warn("WRN $log_id " . scalar(caller) . " $text\n");
157             }
158 0         0 return 1;
159             }
160              
161              
162              
163             sub fatal {
164              
165             =head2 fatal
166              
167             $log->fatal($text)
168              
169             Output a fatal entry using the L module, if loaded.
170              
171             =cut
172              
173             # call Mnet::Log output if loaded or die
174             # $^S is undef while compiling/parsing, true in eval, false otherwise
175 1     1 1 3 my ($self, $text) = (shift, shift);
176 1 50       4 if ($INC{"Mnet/Log.pm"}) {
177 0 0       0 CORE::die("$text\n") if $^S;
178 0         0 Mnet::Log::output($self, "DIE", 2, scalar(caller), $text);
179             } else {
180 1   50     7 my $log_id = $self->{log_id} // "-";
181 1         12 CORE::die("DIE $log_id " . scalar(caller) . " $text\n");
182             }
183 0           exit 1;
184             }
185              
186              
187              
188             =head1 FUNCTIONS
189              
190             Mnet::Log::Conditional also implements the functions listed below.
191              
192             =cut
193              
194              
195              
196             sub DEBUG {
197              
198             =head2 DEBUG
199              
200             DEBUG($text)
201              
202             Output a debug entry using the L module, if loaed.
203              
204             =cut
205              
206             # call Mnet::Log::output if loaded or return;
207 0     0 1   my $text = shift;
208             return Mnet::Log::output(undef, "dbg", 7, scalar(caller), $text)
209 0 0         if $INC{"Mnet/Log.pm"};
210 0           return 1;
211             }
212              
213              
214              
215             sub INFO {
216              
217             =head2 INFO
218              
219             INFO($text)
220              
221             Output an info entry using the L module, if loaed.
222              
223             =cut
224              
225             # call Mnet::Log::output if loaded or return;
226 0     0 1   my $text = shift;
227             return Mnet::Log::output(undef, "inf", 6, scalar(caller), $text)
228 0 0         if $INC{"Mnet/Log.pm"};
229 0           return 1;
230             }
231              
232              
233              
234             sub NOTICE {
235              
236             # NOTICE($text)
237             # purpose: output notice using Mnet::Log if loaded, otherwise nothing happens
238              
239             # call Mnet::Log::output if loaded or return;
240 0     0 0   my $text = shift;
241             return Mnet::Log::output(undef, "---", 5, scalar(caller), $text)
242 0 0         if $INC{"Mnet/Log.pm"};
243 0           return 1;
244             }
245              
246              
247              
248             sub WARN {
249              
250             =head2 WARN
251              
252             WARN($text)
253              
254             Output a warn entry using the L module, if loaed.
255              
256             =cut
257              
258             # call Mnet::Log::output if loaded or warn
259 0     0 1   my $text = shift;
260 0 0         if ($INC{"Mnet/Log.pm"}) {
261 0           Mnet::Log::output(undef, "WRN", 4, scalar(caller), $text);
262             } else {
263 0           $text =~ s/\n*$//;
264 0           CORE::warn("WRN - " . scalar(caller) . " $text\n");
265             }
266 0           return 1;
267             }
268              
269              
270              
271             sub FATAL {
272              
273             =head2 FATAL
274              
275             FATAL($text)
276              
277             Output a fatal entry using the L module, if loaed.
278              
279             =cut
280              
281             # call Mnet::Log::output if loaded or die
282 0     0 1   my $text = shift;
283 0 0         if ($INC{"Mnet/Log.pm"}) {
284 0           Mnet::Log::output(undef, "DIE", 2, scalar(caller), $text);
285             } else {
286 0           CORE::die("DIE - " . scalar(caller) . " $text\n");
287             }
288 0           exit 1;
289             }
290              
291              
292              
293             =head1 SEE ALSO
294              
295             L
296              
297             L
298              
299             =cut
300              
301             # normal end of package
302             1;
303