File Coverage

blib/lib/Carp/Diagnostics.pm
Criterion Covered Total %
statement 60 66 90.9
branch 18 24 75.0
condition 12 12 100.0
subroutine 18 18 100.0
pod 7 7 100.0
total 115 127 90.5


line stmt bran cond sub pod time code
1              
2             package Carp::Diagnostics ;
3              
4 3     3   154706 use strict;
  3         9  
  3         124  
5 3     3   18 use warnings ;
  3         8  
  3         145  
6              
7             my $WIN32_CONSOLE ;
8              
9             BEGIN
10             {
11 3     3   3529 use English qw( -no_match_vars ) ;
  3         18811  
  3         23  
12 3     3   4771 use Sub::Exporter -setup => { exports => [ qw(carp cluck croak confess UseLongMessage) ] } ;
  3         42825  
  3         34  
13            
14 3     3   1422 use vars qw ($VERSION);
  3         6  
  3         358  
15 3     3   8 $VERSION = '0.05' ;
16              
17             #-------------------------------------------------------------------------------
18              
19 3 50       18 if($OSNAME ne 'MSWin32')
20             {
21 3     3   229 eval "use Term::Size;" ; ## no critic
  3         8785  
  3         10923  
  3         112  
22 3 50       90 Carp::croak $EVAL_ERROR if $EVAL_ERROR;
23             }
24             else
25             {
26 0         0 eval "use Win32::Console;" ; ## no critic
27 0 0       0 Carp::croak $EVAL_ERROR if $EVAL_ERROR ;
28            
29 0         0 $WIN32_CONSOLE= new Win32::Console;
30             }
31             }
32              
33             #-------------------------------------------------------------------------------
34              
35 3     3   2766 use Readonly ;
  3         10184  
  3         212  
36             Readonly my $EMPTY_STRING => q{} ;
37              
38 3     3   23 use Carp qw() ;
  3         7  
  3         75  
39              
40 3     3   3178 use IO::String ;
  3         14575  
  3         111  
41 3     3   8633 use Pod::Text ;
  3         209286  
  3         7005  
42              
43             =head1 NAME
44              
45             Carp::Diagnostics - Carp with a diagnostic message
46              
47             =head1 SYNOPSIS
48              
49             use Carp::Diagnostics qw(cluck carp croak confess) ;
50            
51             CroakingSub() ;
52            
53             #---------------------------------------------------------------------------
54            
55             sub CroakingSub
56             {
57            
58             =head2 CroakingSub
59            
60             An example of how to use Carp::Diagnostics.
61            
62             =head3 Diagnostics
63            
64             =cut
65            
66             my ($default_rule_name, $name) = ('c_objects', 'o_cs_meta') ;
67            
68             confess
69             (
70             "Default rule '$default_rule_name', in rule '$name', doesn't exist.\n",
71            
72             <
73            
74             =over
75            
76             =item Default rule '$default_rule_name', in rule '$name', doesn't exist!
77            
78             The default rule of a I B must be registrated before
79             the B definiton. Here is an example of declaration:
80            
81             AddRule 'c_o', [ '*/*.o' => '*.c' ], \&C_Builder ;
82             AddRule 'cpp_o', [ '*/*.o' => '*.cpp' ], \&CPP_Builder ;
83            
84             AddRule [META_RULE], 'o_cs_meta',
85             [\&FirstAndOnlyOneOnDisk, ['cpp_o', 'c_o' ], 'c_o'] ;
86             ^- slave rules -^ ^-default
87            
88             =back
89            
90             =cut
91            
92             END_OF_POD
93             ) ;
94            
95             }
96              
97             =head1 DESCRIPTION
98              
99             This module overrides the subs defined in L to allow you to give informative diagnostic messages.
100              
101             =head1 DOCUMENTATION
102              
103             Perl Best Practices recommends to have a B section, in your B, where all your warnings and errors are
104             explained in details. Although I like the principle, I dislike its proposed implementation. Why should we display
105             cryptic messages at run time that the user have to lookup in the documentation? I also dislike to have the
106             diagnostics grouped far from where the errors are generated, they never get updated.
107              
108             This modules implements the four subs exported by the Carp module (carp, croak, cluck, confess). The new
109             subs take zero, one or two arguments.
110              
111             =head2 No argument
112              
113             =over 2
114              
115             =item * No message
116              
117             =back
118              
119             =head2 One argument
120              
121             =over 2
122              
123             =item * A message
124              
125             =back
126              
127             =head2 Two arguments
128              
129             =over 2
130              
131             =item * A short message
132              
133             =item * A diagnostic message
134              
135             The long message is a diagnostic and is the one normally displayed.
136              
137             You can direct B to display the short message; this is useful when developing modules.
138             You, the module author, understand short warnings. See L.
139              
140             =back
141              
142             Having the possibility to pass one argument or two gives you the possibility to drop-in B in your module
143             without having to modify all the call to the carping subs. if you decide to add Diagnostics to any of your subs, just add the
144             second argument to, your already existing, carp call.
145              
146             The I functionality is always on.
147              
148             B is used internally so you get an identical functionality.
149              
150             =head2 POD: Eating your cake and having it too.
151              
152             The good news is that you are going to do two things in one shot. You'll be giving better diagnostics to your users
153             and you'll be documenting your modules too.
154              
155             If the long message (diagnostic) is B (the first non space character is an '=' at the start of the line), B
156             will convert the pod to text and pass it to B.
157              
158             $ perl cd_test.pl
159            
160             Default rule 'c_objects', in rule 'o_cs_meta', doesn't exist!
161             The default rule of a *FirstAndOnlyOneOnDisk* META_RULE must be registrated before the
162             META_RULE definiton. Here is an example of declaration:
163            
164             AddRule 'c_o', [ '*/*.o' => '*.c' ], \&C_Builder ;
165             AddRule 'cpp_o', [ '*/*.o' => '*.cpp' ], \&CPP_Builder ;
166            
167             AddRule [META_RULE], 'o_cs_meta',
168             [\&FirstAndOnlyOneOnDisk, ['cpp_o', 'c_o' ], 'c_o'] ;
169             ^- slave rules -^ ^-default
170            
171             at cd_test.pl line 26
172             main::CroakingSub() called at cd_test.pl line 11
173              
174             Since the diagnostic is valid pod, it will be extracted when you generate your documentation.
175              
176             $ pod2text cd_test.pl
177            
178             CroakingSub
179             An example of how to use Carp::Diagnostics.
180            
181             Diagnostics
182             Default rule '$default_rule_name', in rule '$name', doesn't exist!
183             The default rule of a *FirstAndOnlyOneOnDisk* META_RULE must be
184             registrated before the META_RULE definiton. Here is an example of
185             declaration:
186            
187             AddRule 'c_o', [ '*/*.o' => '*.c' ], \&C_Builder ;
188             AddRule 'cpp_o', [ '*/*.o' => '*.cpp' ], \&CPP_Builder ;
189            
190             AddRule [META_RULE], 'o_cs_meta',
191             [\&FirstAndOnlyOneOnDisk, ['cpp_o', 'c_o' ], 'c_o'] ;
192             ^- slave rules -^ ^-default
193              
194             =head1 SUBROUTINES/METHODS
195              
196             =cut
197              
198             {
199             my $use_long_message = 1 ;
200              
201             sub UseLongMessage
202             {
203              
204             =head2 UseLongMessage
205              
206             Give I<0> as argument if you want to display the short message. The only reason to use this
207             is when developing modules which use B. Even then it's not a very good reason
208             for not displaying a complete diagnostic.
209              
210             This setting is global.
211              
212             =cut
213              
214 16 100   16 1 2577 $use_long_message = $_[0] if defined $_[0] ;
215 16         96 return($use_long_message) ;
216             }
217              
218             }
219              
220             #-------------------------------------------------------------------------------
221              
222             sub croak
223             {
224              
225             =head2 croak
226              
227             =head3 arguments
228              
229             =over 2
230              
231             =item short_message
232              
233             =item diagnostic (long message)
234              
235             =back
236              
237             if the diagnostic is POD, it will be converted to text.
238              
239             Calls Carp::croak to display the message.
240              
241             =cut
242              
243 8     8 1 7521 local $Carp::CarpLevel = 1; ## no critic
244              
245 8 100 100     56 Carp::croak
246             (
247             Podify
248             (
249             @_ == 1 || (! UseLongMessage())
250             ? $_[0] # user wants short message or there is only one message
251             : $_[1]
252             )
253             ) ;
254              
255              
256 0         0 return ;
257             }
258              
259             #-------------------------------------------------------------------------------
260              
261             sub confess
262             {
263              
264             =head2 confess
265              
266             =head3 arguments
267              
268             =over 2
269              
270             =item short_message
271              
272             =item diagnostic (long message)
273              
274             =back
275              
276             if the diagnostic is POD, it will be converted to text.
277              
278             Calls Carp::confess to display the message.
279              
280             =cut
281              
282 4     4 1 8176 local $Carp::CarpLevel = 1; ## no critic
283 4 100 100     33 Carp::confess
284             (
285             Podify
286             (
287             @_ == 1 || (! UseLongMessage())
288             ? $_[0] # user wants short message or there is only one message
289             : $_[1]
290             )
291             ) ;
292              
293 0         0 return ;
294             }
295              
296             #-------------------------------------------------------------------------------
297              
298             sub carp
299             {
300              
301             =head2 carp
302              
303             =head3 arguments
304              
305             =over 2
306              
307             =item short_message
308              
309             =item diagnostic (long message)
310              
311             =back
312              
313             if the diagnostic is POD, it will be converted to text.
314              
315             Calls Carp::carp to display the message.
316              
317             =cut
318              
319 4     4 1 2412 local $Carp::CarpLevel = 1; ## no critic
320 4 100 100     31 Carp::carp
321             (
322             Podify
323             (
324             @_ == 1 || (! UseLongMessage())
325             ? $_[0] # user wants short message or there is only one message
326             : $_[1]
327             )
328             ) ;
329              
330 4         6269 return ;
331             }
332              
333             #-------------------------------------------------------------------------------
334              
335             sub cluck
336             {
337              
338             =head2 cluck
339              
340             =head3 arguments
341              
342             =over 2
343              
344             =item short_message
345              
346             =item diagnostic (long message)
347              
348             =back
349              
350             if the diagnostic is POD, it will be converted to text.
351              
352             Calls Carp::cluck to display the message.
353              
354             =cut
355              
356 4     4 1 1871 local $Carp::CarpLevel = 1; ## no critic
357 4 100 100     36 Carp::cluck
358             (
359             Podify
360             (
361             @_ == 1 || (! UseLongMessage())
362             ? $_[0] # user wants short message or there is only one message
363             : $_[1]
364             )
365             ) ;
366              
367 4         3421 return ;
368             }
369              
370             #-------------------------------------------------------------------------------
371              
372             sub Podify
373             {
374              
375             =head2 Podify
376              
377             Transforms the passed string from B to text if it looks like POD. Returns the string. Transformed or not.
378              
379             This is used internally by this module.
380              
381             =cut
382              
383 20     20 1 42 my ($message) = @_ ;
384              
385 20 100       45 if(defined $message)
386             {
387 16 100       58 if($message =~ /\A\s*^=/xsm)
388             {
389 2         24 my ($in, $out) = (IO::String->new($message), IO::String->new());
390              
391 2         173 Pod::Text->new (width => GetTerminalWidth() - 2 )->parse_from_filehandle($in, $out) ;
392            
393 2         2273 return(${$out->string_ref()}) ;
  2         11  
394             }
395             else
396             {
397 14         215 return($message) ;
398             }
399             }
400             else
401             {
402 4         44 return ;
403             }
404             }
405              
406             #-------------------------------------------------------------------------------
407              
408             sub GetTerminalWidth
409             {
410              
411             =head2 GetTerminalWidth
412              
413             Return the terminal width or 78 if it can't compute the width (IE: redirected to a file).
414              
415             This is used internally by this module.
416              
417             =cut
418              
419 2     2 1 33 my ($columns, $rows) ;
420              
421 2 50       42 if($OSNAME ne 'MSWin32')
422             {
423 2         186 eval "(\$columns, \$rows) = Term::Size::chars *STDOUT{IO} ;" ; ## no critic
424             }
425             else
426             {
427 0         0 ($columns, $rows) = $WIN32_CONSOLE->Size();
428             }
429              
430 2 50       17 $columns = 78 if($columns eq $EMPTY_STRING) ;
431            
432 2         79 return($columns) ;
433             }
434              
435             #-------------------------------------------------------------------------------
436              
437             1 ;
438              
439             =head1 BUGS AND LIMITATIONS
440              
441             None so far.
442              
443             =head1 AUTHOR
444              
445             Khemir Nadim ibn Hamouda
446             CPAN ID: NKH
447             mailto:nadim@khemir.net
448              
449             =head1 LICENSE AND COPYRIGHT
450              
451             This program is free software; you can redistribute
452             it and/or modify it under the same terms as Perl itself.
453              
454             =head1 SUPPORT
455              
456             You can find documentation for this module with the perldoc command.
457              
458             perldoc Carp::Diagnostics
459              
460             You can also look for information at:
461              
462             =over 4
463              
464             =item * AnnoCPAN: Annotated CPAN documentation
465              
466             L
467              
468             =item * RT: CPAN's request tracker
469              
470             Please report any bugs or feature requests to L .
471              
472             We will be notified, and then you'll automatically be notified of progress on
473             your bug as we make changes.
474              
475             =item * Search CPAN
476              
477             L
478              
479             =back
480              
481             =head1 SEE ALSO
482              
483             Perl Best Practice by Damian Conway ISBN: 0-596-00173-8, a tremendous job.
484              
485             =cut