File Coverage

blib/lib/Mnet/Log/Conditional.pm
Criterion Covered Total %
statement 25 66 37.8
branch 2 24 8.3
condition 1 12 8.3
subroutine 8 17 47.0
pod 9 11 81.8
total 45 130 34.6


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