File Coverage

blib/lib/Carp/Datum.pm
Criterion Covered Total %
statement 117 174 67.2
branch 46 92 50.0
condition 12 30 40.0
subroutine 23 29 79.3
pod 10 19 52.6
total 208 344 60.4


line stmt bran cond sub pod time code
1             # -*- Mode: perl -*-
2             #
3             # $Id: Datum.pm,v 0.1.1.2 2001/07/13 17:04:58 ram Exp $
4             #
5             # Copyright (c) 2000-2001, Christophe Dehaudt & Raphael Manfredi
6             #
7             # You may redistribute only under the terms of the Artistic License,
8             # as specified in the README file that comes with the distribution.
9             #
10             # HISTORY
11             # $Log: Datum.pm,v $
12             # Revision 0.1.1.2 2001/07/13 17:04:58 ram
13             # patch2: integrated mods made by CDE:
14             # patch2: added DEBUG CONFIGURATION section
15             # patch2: added HISTORY AND CREDITS section
16             # patch2: fixed demo script to include leading DFEATURE call
17             #
18             # Revision 0.1.1.1 2001/05/30 21:09:36 ram
19             # patch1: added LIMITATIONS section to warn about stringify overloading
20             #
21             # Revision 0.1 2001/03/31 10:04:36 ram
22             # Baseline for first Alpha release.
23             #
24             # $EndLog$
25             #
26              
27 5     5   3859 use strict;
  5         8  
  5         262  
28              
29             package Carp::Datum;
30              
31 5     5   25 use vars qw($VERSION);
  5         9  
  5         305  
32             $VERSION = '0.101';
33              
34 5     5   4337 use Log::Agent;
  5         173671  
  5         734  
35 5     5   47 use Log::Agent qw(logwrite);
  5         12  
  5         393  
36              
37 5     5   5661 use Getargs::Long qw(ignorecase);
  5         76574  
  5         45  
38              
39 5     5   15467 use Carp::Datum::Flags;
  5         13  
  5         748  
40             require Carp::Datum::Parser;
41              
42             require Exporter;
43 5     5   88 use vars qw(@ISA @EXPORT @EXPORT_OK @EXPORT_FAIL %EXPORT_TAGS);
  5         10  
  5         686  
44             @ISA = qw(Exporter);
45             @EXPORT = (qw(DLOAD_CONFIG
46             DFEATURE
47             DTRACE
48             DASSERT
49             VERIFY
50             DREQUIRE
51             DENSURE
52             DVAL
53             DARY
54             DVOID
55             implies
56             equiv
57             ),
58             @Carp::Datum::Flags::EXPORT);
59             @EXPORT_FAIL = qw(on off);
60             @EXPORT_OK = qw(on off);
61             %EXPORT_TAGS = (all => \@EXPORT);
62              
63 5         13999 use vars qw(
64             $DBG
65             $DEBUG_TABLE
66             $CFG
67 5     5   25 );
  5         9  
68              
69             $DBG = DBG_OFF;
70              
71             require Carp::Datum::Cfg;
72             $CFG = Carp::Datum::Cfg->make();
73              
74              
75             $DEBUG_TABLE = {default => { debug => [DBG_ALL, 0],
76             trace => [TRC_ALL, 0],
77             args => -1
78             },
79             alias => []
80             };
81              
82              
83             #
84             # ->export_fail
85             #
86             # Called by Exporter when one of the symbols listed in @EXPORT_FAIL is
87             # indeed exported.
88             #
89             sub export_fail {
90 4     4 0 824 my ($self, @syms) = @_;
91 4         8 my @failed;
92 4         68 foreach my $sym (@syms) {
93 4 100       25 if ($sym eq 'on') { $DBG = DBG_ON }
  2 50       6  
94 2         5 elsif ($sym eq 'off') { $DBG = DBG_OFF }
95 0         0 else { push(@failed, $sym) }
96             }
97              
98 4 100       35 Log::Agent::DATUM_is_here() if $DBG; # Intercept Log::Agent traces
99              
100 4         14638 return @failed; # Empty list if OK
101             }
102              
103             #
104             # DLOAD_CONFIG
105             #
106             # read the debug input to get the debug instructions. Filename
107             # content and raw string configuration are concatened to be parsed.
108             #
109             # Arguments:
110             # -file => $filename: file to load [optionnal]
111             # -config => $string: string which contains config set up [optionnal]
112             # -trace => boolean: print the parsing result when true [optionnal]
113             #
114             sub DLOAD_CONFIG {
115 0 0   0 0 0 return unless $DBG;
116              
117 0         0 my ($dump_parser, @remaining) = cgetargs(@_, {-strict => 0, -extra => 1},
118             [qw(trace)]);
119              
120 0         0 require Carp::Datum::Cfg;
121 0         0 $CFG = Carp::Datum::Cfg->make(@remaining);
122            
123 0         0 Log::Agent::DATUM_is_here(); # Intercept Log::Agent traces
124              
125 0 0       0 return unless $dump_parser == 1;
126              
127 0         0 require Data::Dumper;
128 0         0 DTRACE(TRC_DEBUG, Data::Dumper::Dumper($CFG->cfg_table));
129              
130 0         0 return;
131             }
132              
133              
134             #
135             # DFEATURE
136             #
137             #
138             sub DFEATURE {
139 14 100 66 14 1 14818 return unless $DBG && $CFG->check_debug(DBG_FLOW);
140              
141             #
142             # This routine is usually called as:
143             #
144             # DFEATURE(my $f, "any", "other", $param);
145             #
146             # so the first argument is a lexical lvalue.
147             #
148             # To ensure the tracing capabilities, we rely on the immediate collecting
149             # of the "$f" lexical as soon as the scope of the routine is left: the
150             # DESTROY hook will be called on the Carp::Datum object, so we'll know.
151             #
152             # One day, Perl's garbage collecting scheme may loose this systematic
153             # destroying of lexicals by differing object reclaiming if reference
154             # counting is abandonned and GC algorithms requiring object traversal
155             # are implemented.
156             #
157             # When that day comes, the alternative will be to systematically use
158             # the DVOID, DVAL and DARY on returning, and to maintain a parallel
159             # stack here. Exceptions will be detected by tagging the depth level
160             # and checking it at DVOID, DVAL or DARY time. This will probably require
161             # probing the subroutine name of our caller, and computing the depth
162             # of the perl stack if the caller does not match. And to handle recursion,
163             # and exceptions happening in there, to flag places where eval() is used
164             # so that we know where to look if the stack depth is not as deep as
165             # expected.
166             #
167             # A huge work anyway, so despite reference counting not being the best
168             # GC algorithm, it has the nice property of being somewhat predictible.
169             # It's usually bad to depend on such knowledge, but here that's very,
170             # and I mean VERY, convenient.
171             #
172             # -- RAM, 01/10/2000
173             #
174              
175 5         68 $_[0] = new Carp::Datum(@_[1 .. $#_]);
176 5         15 return;
177              
178             # XXX use weakrefs in 5.6 and above to keep track of those objects in
179             # XXX a parallel stack, and to fix display ordering in DESTROY, where
180             # XXX the caller is sometimes destroyed before the callee.
181             }
182              
183             #
184             # DVOID
185             # DVAL
186             # DARY
187             #
188             # Print the return code and effectively return it.
189             #
190             # When the given parameter is an array and the return context is also
191             # an array, there is no trouble to determine what is returned: it is the
192             # array.
193             #
194             # But when the context is a scalar, it is more difficult since the
195             # parameter might be either a regular array, or a list of
196             # statement. For the fist case, the function must return the number of
197             # elements , and the latter form must return the last statements
198             # value.
199             #
200             # Use DVOID when you would otherwise say "return;".
201             # Use DVAL to return a scalar, or the last element of a list when called in
202             # scalar context, the list when called in array context (wantarray).
203             # Use DARY when you return a list, and it will be taken as the amount of items
204             # when you're called in scalar context, and as the list otherwise.
205             #
206             # To be properly stripped when assertions are to be removed from the code,
207             # one should say:
208             #
209             # return DVAL 1; # will become "return 1;"
210             #
211             # and NOT:
212             #
213             # return DVAL(1); # will really become "return (1);"
214             #
215             # unless you really mean:
216             #
217             # return DVAL (1);
218             #
219             # i.e. the DVOID, DVAL and DARY words are to be thought as "tags" that will be
220             # removed, without otherwise touching anything else.
221             #
222              
223             sub DVOID {
224 5 100 66 5 1 1384 return unless $DBG && $CFG->check_debug(DBG_RETURN);
225              
226 2         8 trace("Returning" . where(1));
227 2         471 return;
228             }
229              
230             sub DVAL {
231 9 50 66 9 1 71 return wantarray ? @_: $_[$#_]
    100          
232             unless $DBG && $CFG->check_debug(DBG_RETURN);
233              
234             # fix the arg list when the value to return is undef
235 3 50       10 @_ = (undef) if $#_ == -1;
236              
237 0         0 trace("Returning: " .
238             (wantarray ?
239 3 50       11 "(" . (join ', ', (map {data_format($_)} @_)) . ")":
240             data_format($_[$#_])) .where(1));
241 3 50       790 return (wantarray ? @_ : $_[$#_]);
242             }
243              
244             sub DARY {
245 0 0 0 0 1 0 return @_ unless $DBG && $CFG->check_debug(DBG_RETURN);
246              
247             # fix the arg list when the value to return is undef
248             # @_ = () if $#_ == -1;
249              
250             # get the scalar of the array
251 0         0 my $a = @_;
252              
253 0         0 trace("Returning: " .
254             (wantarray ?
255 0 0       0 "(" . (join ', ', (map {data_format($_)} @_)) . ")":
256             data_format(scalar @_)) .where(1));
257              
258 0         0 return @_;
259             }
260              
261             #
262             # DTRACE
263             #
264             # Arguments Form 1:
265             # {-level => level, -marker => marker}, message
266             #
267             # Arguments Form 2:
268             # level, message
269             #
270             # Arguments Form 3:
271             # message
272             #
273             sub DTRACE {
274 4 50 66 4 0 6013 return if $DBG && !$CFG->check_debug(DBG_TRACE);
275              
276             # parse arguments
277 4         8 my $level = TRC_DEBUG;
278 4         9 my $marker = '';
279 4 50       13 if (ref $_[0] eq 'HASH') {
280 0         0 my $hashref = shift;
281 0 0       0 if (defined $hashref->{-level}) {
282 0         0 $level = $hashref->{-level};
283             }
284 0 0       0 if (defined $hashref->{-marker}) {
285 0         0 $marker = $hashref->{-marker};
286             }
287             }
288             else {
289 4 100       24 if ($_[0] =~ /^\d+$/) {
290             # take the first argument as level if it is not alone
291 2 50       7 if ($#_ > 0) {
292 2         6 $level = shift;
293             }
294             }
295             }
296              
297 4 100       12 if ($DBG) {
298             # check whether tracing level is permitted
299 2 50       7 return unless $CFG->check_trace($level);
300            
301 2         9 trace(join('', @_) . where(1), $marker);
302 2         528 return;
303             }
304              
305             #
306             # No debugging activated, call must be remapped to Log::Agent.
307             #
308              
309             %Carp::Datum::logmap = (
310 2 100       22 TRC_EMERGENCY() => [\&logdie, undef], # panic
311             TRC_ALERT() => [\&logerr, undef],
312             TRC_CRITICAL() => [\&logerr, undef],
313             TRC_ERROR() => [\&logerr, undef],
314             TRC_WARNING() => [\&logwarn, undef],
315             TRC_NOTICE() => [\&logsay, undef],
316             TRC_INFO() => [\&logtrc, 'info'],
317             TRC_DEBUG() => [\&logtrc, 'debug'],
318             ) unless defined %Carp::Datum::logmap;
319              
320 2         4 my $entry = $Carp::Datum::logmap{$level};
321              
322             #
323             # Use magic "goto &" to forget about the DTRACE call.
324             #
325             # That's important if they use the caller indication feature
326             # in Log::Agent. Otherwise, all calls would be traced from here.
327             #
328              
329 2 50       4 if (defined $entry) {
330 2         4 my ($fn, $loglvl) = @$entry;
331 2 100       9 @_ = defined $loglvl ? ($loglvl, join('', @_)) : (join '', @_);
332 2         13 goto &$fn;
333             } else {
334 0         0 @_ = (join '', @_);
335 0         0 goto &logerr;
336             }
337              
338 0         0 return;
339             }
340              
341             #
342             # DASSERT
343             #
344             sub DASSERT {
345 0 0   0 1 0 return assert(DBG_PANIC|DBG_STACK, 'assertion', @_) unless $DBG;
346              
347 0         0 my $dbg_flag = $CFG->flag('debug');
348 0 0       0 return unless $dbg_flag & DBG_ASSERT;
349              
350 0         0 assert($dbg_flag, 'assertion', @_);
351             }
352              
353             #
354             # DREQUIRE
355             #
356             sub DREQUIRE {
357 6 100   6 1 58 return assert(DBG_PANIC|DBG_STACK, 'pre-condition', @_) unless $DBG;
358              
359 2         8 my $dbg_flag = $CFG->flag('debug');
360 2 50       8 return unless $dbg_flag & DBG_REQUIRE;
361              
362 2         8 assert($dbg_flag, 'pre-condition', @_);
363             }
364              
365             #
366             # VERIFY
367             #
368             # same behavior as a DREQUIRE, but it cannot be disabled with the
369             # Datum debug flag. It is useful to protect the edge of a module from
370             # the external invocation.
371             sub VERIFY {
372 0     0 1 0 my ($test, $string) = @_;
373              
374 0         0 assert(DBG_PANIC|DBG_STACK, 'verify', @_);
375             }
376              
377              
378             #
379             # DENSURE
380             #
381             sub DENSURE {
382 6 100   6 1 52 return assert(DBG_PANIC|DBG_STACK, 'post-condition', @_) unless $DBG;
383              
384 2         8 my $dbg_flag = $CFG->flag('debug');
385 2 50       6 return unless $dbg_flag & DBG_ENSURE;
386              
387 2         6 assert($dbg_flag, 'post-condition', @_);
388             }
389              
390              
391             #
392             # implies
393             #
394             # Implement the logical operation (migth be useful for assertion)
395             #
396             sub implies {
397 0   0 0 1 0 return (!$_[0]) || $_[1];
398             }
399              
400             #
401             # equiv
402             #
403             # Implement the logical operation (migth be useful for assertion)
404             #
405             sub equiv {
406 0     0 1 0 return !$_[0] == !$_[1];
407             }
408              
409             #
410             # assert
411             #
412             # perhaps modify the signature when caching features is implemented for
413             # CFG
414             #
415             sub assert {
416 12     12 0 15 my $debug_flag = shift;
417 12         19 my $assert_type = shift;
418 12         15 my $test = shift;
419              
420 12 50       92 return if $test;
421              
422             #
423             # Carp::Datum is potentially used by many modules. Its core code
424             # must be as small as possible to compile quickly.
425             #
426             # Here, we get an assertion failure, an exceptional event. It's ok
427             # to impose a further delay.
428             #
429              
430 0         0 require Carp::Datum::Assert;
431 0         0 Carp::Datum::Assert->import(qw(assert_expr stack_dump));
432              
433 0         0 my $expr = assert_expr(2);
434 0         0 my $msg;
435 0 0       0 $msg = ": " . join('', @_) if @_;
436 0 0       0 $msg .= " ($expr)" if $expr ne '';
437 0         0 $msg = $msg . where(2);
438 0         0 my $stack = stack_dump(2);
439              
440             #
441             # When debugging, log to the debug file.
442             #
443            
444 0 0       0 if ($DBG) {
445 0         0 trace("$assert_type FAILED". $msg, "!!");
446 0 0       0 if ($debug_flag & DBG_STACK) {
447 0         0 foreach my $item (@$stack) {
448 0         0 trace($item, "!!");
449             }
450             }
451             }
452              
453             #
454             # Always log something to the error channel anyway
455             #
456             # If they configured Log::Agent with -confess, they'll get a
457             # stack dump as well on panic.
458             #
459              
460 0 0       0 if ($debug_flag & DBG_PANIC) {
461 0         0 logdie "PANIC: $assert_type FAILED" . $msg;
462             } else {
463 0         0 logwarn "$assert_type FAILED" . $msg;
464             }
465             }
466              
467             #
468             # alias
469             #
470             # Alias filename, to strip long filenames.
471             #
472             sub alias {
473 16     16 0 25 my ($name) = @_;
474              
475 16         18 for my $alias (@{$CFG->cfg_alias}) {
  16         50  
476 0         0 my ($x, $y) = @{$alias};
  0         0  
477 0 0       0 if (substr($name, 0, length $x) eq $x) {
478 0         0 substr($name, 0, length $x) = $y;
479 0         0 last;
480             }
481             }
482              
483 16         39 return $name;
484             }
485              
486             #
487             # where
488             #
489             sub where {
490 12     12 0 19 my ($level) = @_;
491 12         51 my ($package, $filename, $line) = caller($level);
492 12         35 $filename = alias($filename);
493              
494 12         60 return " [$filename:$line]";
495             }
496              
497             my $DEPTH = 0;
498             my $max_trace_depth = -1;
499             my $space = "| ";
500              
501             #
502             # ->new
503             #
504             # Create a new object, meant to be destroyed at function exit
505             #
506             sub new {
507 5     5 0 10 my $this = shift @_;
508 5   33     27 my $class = ref($this) || $this;
509 5         9 my $self = {};
510            
511             # get the max argument setting (by specifying 'args(yes|no|num);'
512             # in config file.
513             # NOTE: that is done before the arg query since the call is
514             # modifying the DB::args value with different values.
515 5         16 my $max_arg = $CFG->flag('args', 1);
516              
517 5         8 my $offset = 2;
518 5         27 my ($package, $filename, $line) = caller($offset);
519 5         22 my $sub = (caller($offset + 1))[3];
520 5 100       26 $sub = $sub ? "$sub()" : "global";
521 5         7 my $from = '';
522 5 100       26 $from = " from $sub at " . alias($filename) . ":$line" if defined $line;
523              
524             package DB;
525             # ignore warning
526 5     5   44 use vars qw(@args);
  5         29  
  5         4787  
527 5         26 my @caller = caller(2);
528             package Carp::Datum;
529            
530             # grab info from leftover parameters
531 5 50       20 my $info = @_ ? ": '@_'": "";
532            
533 5 100       16 if (@caller) {
534             # shrink the list of argument if too long
535 4         6 my $shrinked = 0;
536 4 50 33     21 if ($max_arg >= 0 && $#DB::args >= $max_arg ) {
537 0         0 $#DB::args = $max_arg - 1;
538 0         0 $shrinked = 1;
539             }
540              
541 4         11 my @args_list = map { data_format($_) } @DB::args;
  3         7  
542 4 50       13 push @args_list, "..." if $shrinked;
543              
544 4         26 $self->{'call'} = "$caller[3](" . join(", ", @args_list) . ")$info";
545             } else {
546 1         5 $self->{'call'} = "global$info"
547             }
548 5         13 $self->{'call'} .= $from;
549            
550 5         20 trace("+-> " . $self->{'call'} . where($offset));
551 5         18754 $self->{'depth'} = $DEPTH++;
552            
553 5         72 bless $self, $class;
554             }
555              
556             #
557             # ->DESTROY
558             #
559             sub DESTROY {
560 5     5   373 my $self = shift;
561              
562 5         10 my $prev_depth = $DEPTH;
563 5         26 $DEPTH = $self->{'depth'};
564 5         25 trace("+-< " . $self->{'call'});
565 5         917 $DEPTH = $prev_depth - 1;
566             }
567              
568             #
569             # trace
570             #
571             sub trace {
572 19     19 0 1160 my ($message, $header) = @_;
573              
574 19         31 $header .= " ";
575 19         28 $header = substr($header, 0, 3);
576              
577 19         499 logwrite('debug', 'debug', $header . $space x $DEPTH . $message);
578             }
579              
580             #
581             # data_format
582             #
583             # return the given value to a printable form.
584             #
585             sub data_format {
586 6 50   6 0 14 return "undef" unless defined $_[0];
587              
588 6 50 33     64 return $_[0] if (ref $_[0]) || ($_[0]=~ /^-?[1-9]\d{0,8}$/) ||
      33        
589             (($_[0] + 0) eq $_[0]) ;
590              
591 0           require Data::Dumper;
592 0           return Data::Dumper::qquote($_[0] );
593             }
594              
595             1;
596              
597             =head1 NAME
598              
599             Carp::Datum - Debugging And Tracing Ultimate Module
600              
601             =head1 SYNOPSIS
602              
603             # In modules
604             use Carp::Datum;
605            
606             # Programming by contract
607             sub routine {
608             DFEATURE my $f_, "optional message"; # $f_ is a lexical lvalue here
609             my ($a, $b) = @_;
610             DREQUIRE $a > $b, "a > b";
611             $a += 1; $b += 1;
612             DASSERT $a > $b, "ordering a > b preserved";
613             my $result = $b - $a;
614             DENSURE $result < 0;
615             return DVAL $result;
616             }
617            
618             # Tracing
619             DTRACE "this is a debug message";
620             DTRACE TRC_NOTICE, "note: a = ", $a, " is positive";
621             DTRACE {-level => TRC_NOTICE, -marker => "!!"}, "note with marker";
622            
623             # Returning
624             return DVAL $scalar; # single value
625             return DARY @list; # list of values
626              
627             # In application's main
628             use Carp::Datum qw(:all on); # turns Datum "on" or "off"
629              
630             DLOAD_CONFIG(-file => "debug.cf", -config => "config string");
631              
632             =head1 DESCRIPTION
633              
634             The C module brings powerful debugging and tracing features
635             to development code: automatic flow tracing, returned value tracing,
636             assertions, and debugging traces. Its various functions may be customized
637             dynamically (i.e. at run time) via a configuration language allowing
638             selective activation on a routine, file, or object type basis. See
639             L for configuration defails.
640              
641             C traces are implemented on top of C and go to its
642             debugging channel. This lets the application have full control of the
643             final destination of the debugging information (logfile, syslog, etc...).
644              
645             C can be globally turned on or off by the application. It is
646             off by default, which means no control flow tracing (routine entry and exit),
647             and no returned value tracing. However, assertions are still fully monitored,
648             and the C calls are redirected to C.
649              
650             The C version of C is implemented with macros, which may
651             be redefined to nothing to remove all assertions in the released
652             code. The Perl version cannot be handled that way, but comes with
653             a C module that will B remove all the
654             assertions, leaving only C calls. Modules using C
655             can make use of C in their Makefile.PL to
656             request stripping at build time. See L for
657             instructions.
658              
659             Here is a small example showing what traces look like, and what happens by
660             default on assertion failure. Since C is not being customized, the
661             debugging channel is STDERR. In real life, one would probably
662             customize Log::Agent with a file driver, and redirect the debug channel
663             to a file separate from both STDOUT and STDERR.
664              
665             First, the script, with line number:
666              
667             1 #!/usr/bin/perl
668             2
669             3 use Carp::Datum qw(:all on);
670             4
671             5 DFEATURE my $f_;
672             6
673             7 show_inv(2, 0.5, 0);
674             8
675             9 sub show_inv {
676             10 DFEATURE my $f_;
677             11 foreach (@_) {
678             12 print "Inverse of $_ is ", inv($_), "\n";
679             13 }
680             14 return DVOID;
681             15 }
682             16
683             17 sub inv {
684             18 DFEATURE my $f_;
685             19 my ($x) = @_;
686             20 DREQUIRE $x != 0, "x=$x not null";
687             21 return DVAL 1 / $x;
688             22 }
689             23
690              
691             What goes to STDOUT:
692              
693             Inverse of 2 is 0.5
694             Inverse of 0.5 is 2
695             FATAL: PANIC: pre-condition FAILED: x=0 not null ($x != 0) [./demo:20]
696              
697             The debugging output on STDERR:
698              
699             +-> global [./demo:5]
700             | +-> main::show_inv(2, 0.5, 0) from global at ./demo:7 [./demo:10]
701             | | +-> main::inv(2) from main::show_inv() at ./demo:12 [./demo:18]
702             | | | Returning: (0.5) [./demo:21]
703             | | +-< main::inv(2) from main::show_inv() at ./demo:12
704             | | +-> main::inv(0.5) from main::show_inv() at ./demo:12 [./demo:18]
705             | | | Returning: (2) [./demo:21]
706             | | +-< main::inv(0.5) from main::show_inv() at ./demo:12
707             | | +-> main::inv(0) from main::show_inv() at ./demo:12 [./demo:18]
708             !! | | | pre-condition FAILED: x=0 not null ($x != 0) [./demo:20]
709             !! | | | main::inv(0) called at ./demo line 12
710             !! | | | main::show_inv(2, 0.5, 0) called at ./demo line 7
711             ** | | | FATAL: PANIC: pre-condition FAILED: x=0 not null ($x != 0) [./demo:20]
712             | | +-< main::inv(0) from main::show_inv() at ./demo:12
713             | +-< main::show_inv(2, 0.5, 0) from global at ./demo:7
714             +-< global
715              
716             The last three lines were manually re-ordered for this manpage: because of the
717             pre-condition failure, Perl enters its global object destruction routine,
718             and the destruction order of the lexicals is not right. The $f_ in show_inv()
719             is destroyed before the one in inv(), resulting in the inversion. To better
720             please the eye, it has been fixed. And the PANIC is emitted when the pre-condition
721             failure is detected, but it would have messed up the trace example.
722              
723             Note that the stack dump is prefixed with the "!!" token, and the fatal
724             error is tagged with "**". This is a visual aid only, to quickly locate
725             troubles in logfiles by catching the eye.
726              
727             Routine entry and exit are tagged, returned values and parameters are
728             shown, and the immediate caller of each routine is also traced. The
729             final tags C refer to the file
730             name (here the script used was called "demo") and the line number
731             where the call to the C routine is made: here the
732             C at line 10. It also indicates the caller origin: here, the
733             call is made at line 7 of file C.
734              
735             The special name "global" (without trailing () marker) is used to indicate
736             that the caller is the main script, i.e. there is no calling routine.
737              
738             Returned values in inv() are traced as "(0.5)" and "(2)", and not as "0.5"
739             and "2" as one would expect, because the routine was called in non-scalar
740             context (within a print statement).
741              
742             =head1 PROGRAMMING BY CONTRACT
743              
744             =head2 Introduction
745              
746             The Programming by Contract paradigm was introduced by Bertrand Meyer in
747             his I book, and later implemented
748             natively in the Eiffel language. It is very simple, yet extremely powerful.
749              
750             Each feature (routine) of a program is viewed externally as a supplier for
751             some service. For instance, the sqrt() routine computes the square root
752             of any positive number. The computation could be verified, but
753             sqrt() probably provides an efficient algorithm for that, and it has already
754             been written and validated.
755              
756             However, sqrt() is only defined for positive numbers. Giving a negative
757             number to it is not correct. The old way (i.e. in the old days before
758             Programming by Contract was formalized), people implemented that restriction
759             by testing the argument I of sqrt(), and doing so in the routine itself
760             to factorize code. Then, on error, sqrt() would return -1 for instance
761             (which cannot be a valid square root for a real number), and the desired
762             quantity otherwise. The caller had then to check the returned value to
763             determine whether an error had occurred. Here it is easy, but in languages
764             where no out-of-band value such as Perl's C are implemented, it can
765             be quite difficult to both report an error and return a result.
766              
767             With Programming by Contract, the logic is reversed, and the code is greatly
768             simplified:
769              
770             =over 4
771              
772             =item *
773              
774             It is up to the caller to always supply a positive value to sqrt(), i.e. to
775             check the value first.
776              
777             =item *
778              
779             In return, sqrt() promises to always return the square root of its argument.
780              
781             =back
782              
783             What are the benefits of such a gentlemen's agreement? The code of the sqrt()
784             routine is much simpler (meaning fewer bugs) because it does not have
785             to bother with handling the case of negative arguments, since the caller
786             promised to never call with such invalid values. And the code of the caller
787             is at worst as complex as before (one test to check that the argument is
788             positive, against a check for an error code) and at best less complex: if it is
789             known that the value is positive, it doesn't even have to be checked, for instance
790             if it is the result of an abs() call.
791              
792             But if sqrt() is called with a negative argument, and there's no explicit test
793             in sqrt() to trap the case, what happens if sqrt() is given a negative
794             value, despite a promise never to do so? Well, it's a bug, and it's a
795             bug in the caller, not in the sqrt() routine.
796              
797             To find those bugs, one usually monitors the assertions (pre- and
798             post-conditions, plus any other assertion in the code, which is both a
799             post-condition for the code above and a pre-condition for the code below,
800             at the same time) during testing. When the product is released, assertions
801             are no longer checked.
802              
803             =head2 Formalism
804              
805             Each routine is equipped with a set of pre-conditions and post-conditions.
806             A routine I is therefore defined as:
807              
808             r(x)
809             pre-condition
810             body
811             post-condition
812              
813             The pre- and post-conditions are expressions involving the parameters of r(),
814             here only I, and, for the post-condition, the returned value of r() as well.
815             Conditions satisfying this property are made visible to the clients, and become
816             the routine's I, which can be written as:
817              
818             =over 4
819              
820             =item *
821              
822             You, the caller, promise to always call me with my pre-condition satisfied.
823             Failure to do so will be a bug in your code.
824              
825             =item *
826              
827             I promise you, the caller, that my implementation will then perform correctly
828             and that my post-condition will be satisfied. Failure to do so will be a
829             bug in my code.
830              
831             =back
832              
833             In object-oriented programming, pre- and post-conditions can also use internal
834             attributes of the object, but then become debugging checks that everything
835             happens correctly (in the proper state, the proper order, etc...) and cannot
836             be part of the contract (for external users of the class) since clients cannot
837             check that the pre-condition is true, because it will not have access to the
838             internal attributes.
839              
840             Furthermore, in object-oriented programming, a redefined feature must I
841             the pre-condition of its parent feature and I its post-condition.
842             It can also keep them as-is. To fully understand why, it's best to read
843             Meyer. Intuitively, it's easy to understand why the pre-condition cannot
844             be strengthened, nor why the post-condition cannot be weakened: because of dynamic
845             binding, a caller of r() only has the static type of the object, not its
846             dynamic type. Therefore, it cannot know in advance which of the routines will
847             be called amongst the inheritance tree.
848              
849             =head2 Common Pitfalls
850              
851             =over 4
852              
853             =item *
854              
855             Do not write both a pre-condition and a test with the same expression.
856              
857             =item *
858              
859             Never write a pre-condition when trying to validate user input!
860              
861             =item *
862              
863             Never write a test on an argument when failure means an error, use a
864             pre-condition.
865              
866             If a pre-condition is so important that it needs to always be
867             monitored, even within the released product, then C
868             provides C, a pre-condition that will always be checked
869             (i.e. never stripped by C). It can be used to protect
870             the external interface of a module against abuse.
871              
872             =head2 Implementation
873              
874             With Carp::Datum, pre-conditions can be given using C or C.
875             Assertions are written with C and post-conditions given by C.
876              
877             Although all assertions could be expressed with only C,
878             stating whether it's a pre-condition with C also has
879             a commentary value for the reader. Moreover, one day, there might be an
880             automatic tool to extract the pre- and post-conditions of all the routines
881             for documentation purposes, and if all assertions are called C,
882             the tool will have a hard time figuring out which is what.
883              
884             Moreover, remember that a pre-condition failure I means a bug in the
885             caller, whilst other assertion failures means a bug near the place of failure.
886             If only for that, it's worth making the distinction.
887              
888             =back
889              
890             =head1 INTERFACE
891              
892             =head2 Control Flow
893              
894             =over 4
895              
896             =item DFEATURE my $f_, I
897              
898             This statement marks the very top of any routine. Do not omit the C
899             which is very important to ensure that what is going to be stored in the
900             lexically scoped $f_ variable will be destroyed when the routine ends.
901             Any name can be used for that lexical, but $f_ is recommended because it is
902             both unlikely to conflict with any real variable and short.
903              
904             The I part will be printed in the logs at routine entry
905             time, and can be used to flag object constructors, for instance, for easier
906             grep'ing in the logs afterwards.
907              
908             =item return DVOID
909              
910             This can be used in place of an ordinary C from a routine.
911             It allows tracing of the return statement.
912              
913             =item return DVAL I
914              
915             Use this form when returning something in scalar context. Do not put any
916             parentheses around I, or it will be incorrectly stripped
917             by C. Examples:
918              
919             return DVAL 5; # OK
920             return DVAL ($a == 1) ? 2 : 4; # WRONG (has parenthesis)
921             return DVAL (1, 2, 4); # WRONG (and will return 4)
922              
923             my $x = ($a == 1) ? 2 : 4;
924             return DVAL $x; # OK
925              
926             return DVAL &foo(); # Will be traced as array context
927              
928             Using DVAL allows tracing of the returned value.
929              
930             =item return DARY (I)
931              
932             Use this form when returning something in list context.
933             Using DARY allows tracing of the returned values.
934              
935             return DARY @x;
936              
937             If a routine returns something different depending on its
938             calling context, then write:
939              
940             return DARY @x if wantarray;
941             return DVAL $x;
942              
943             Be very careful with that, otherwise the program will behave differently
944             when the C and C tokens are stripped by C,
945             thereby raising subtle bugs.
946              
947             =back
948              
949             =head2 Programming by Contract
950              
951             =over 4
952              
953             =item C I, I
954              
955             Specify a pre-condition I, along with a I that will be printed
956             whenever the pre-condition fails, i.e. when I evaluates to false.
957             The I string may be used to dump faulty values, for instance:
958              
959             DREQUIRE $x > 0, "x = $x positive";
960              
961             The I is optional and may be left off.
962              
963             =item C I, I
964              
965             This is really the same as C, except that it will not be stripped
966             by C and that it will always be monitored and cause a
967             fatal error, whatever dynamic configuration is setup.
968              
969             =item C I, I
970              
971             Specify a post-condition I, along with an optional I that will be
972             printed whenever the post-condition fails, i.e. when I evaluates to false.
973              
974             =item C I, I
975              
976             Specify an assertion I, and an optional I printed when I
977             evaluates to false.
978              
979             =back
980              
981             =head2 Tracing
982              
983             Tracing is ensured by the C routine, which is never stripped. When
984             C is off, traces are redirected to C (then channel
985             depends on the level of the trace).
986              
987             The following forms can be used, from the simpler to the more complex:
988              
989             DTRACE "the variable x+1 is ", $x + 1, " and y is $y";
990             DTRACE TRC_WARNING, "a warning message";
991             DTRACE { -level => TRC_CRITICAL, -marker => "##" }, "very critical";
992              
993             The first call emits a trace at the C level, by default. The
994             second call emits a warning at the C level, and the last call
995             emits a C message prefixed with a marker.
996              
997             Markers are 2-char strings emitted in the very first columns of the
998             debugging output, and can be used to put emphasis on specifice messages.
999             Internally, C and C use the following markers:
1000              
1001             !! assertion failure and stack trace
1002             ** critical errors, fatal if not trapped by eval {}
1003             >> a message emitted via a Log::Agent routine, not DTRACE
1004              
1005             The table below lists the available C levels defined by C,
1006             and how they remap to C routines when C is off:
1007              
1008             Carp::Datum Log::Agent
1009             ------------- -------------
1010             TRC_EMERGENCY logdie
1011             TRC_ALERT logerr
1012             TRC_CRITICAL logerr
1013             TRC_ERROR logerr
1014             TRC_WARNING logwarn
1015             TRC_NOTICE logsay
1016             TRC_INFO logtrc "info"
1017             TRC_DEBUG logtrc "debug"
1018              
1019             If an application does not configure C specifically, all the calls
1020             map nicely to perl's native routines (die, warn and print).
1021              
1022             =head2 Convenience Routines
1023              
1024             =over 4
1025              
1026             =item C I, I
1027              
1028             Returns true when both I and I have the same truth value,
1029             whether they are both true or both false.
1030              
1031             =item C I, I
1032              
1033             Returns the truth value of I implies I, which is the same
1034             as:
1035              
1036             !expr1 || expr2
1037              
1038             It is always true except when I is true and I is false.
1039              
1040             Warning: this is function, not a macro. That is to say, both
1041             arguments are evaluated, and there is no short-circuit when I is false.
1042              
1043             =back
1044              
1045             =head1 DEBUG CONFIGURATION
1046              
1047             =head2 Global Switch on/off
1048              
1049             The C module can be turned on/off. This indication must
1050             be included when the module is imported in the main program as
1051             followed:
1052              
1053             # In application's main
1054             use Carp::Datum qw(:all on); # to turn on
1055             use Carp::Datum qw(:all off); # to turn off
1056              
1057             When C is turned off, most of the specific functions
1058             (DFEATURE, ...) continue to be invoked during the program execution
1059             but they return immediately. In details, all the tracing functions are
1060             disconnected, the contracts (DASSERT, DREQUIRE, DENSURE) continue to
1061             be verified: assertion failure will stop the program.
1062              
1063             That leads to a tiny perfomance loss when running production
1064             release. But, the delivered code keeps the possibility to be easily
1065             debugged. If the performance would be problematic in a production
1066             release, there is a stripper program available that can extract all the
1067             C calls from a source file. (see L).
1068              
1069             To turn on/off debugging according to an environment variable, the
1070             module can be imported like the following:
1071              
1072             # In application's main
1073             use Carp::Datum (":all", $ENV{DATUM});
1074              
1075             # as a preamble to the program execution
1076             # in your favorite shell (here /bin/ksh)
1077             export DATUM=on # to turn on
1078             export DATUM=off # to turn off
1079              
1080             =head2 Dynamic Configuration
1081              
1082             The dynamic configuration is loaded when the C function
1083             is invoked in the main program. The function signature passes
1084             either a filename or directly a string (or both).
1085              
1086             DLOAD_CONFIG(-file => "./debug.cf") # filename
1087             - or -
1088             DLOAD_CONFIG(-config => <
1089             routine "show_inv" {
1090             all(yes);
1091             flow(no);
1092             trace(no);
1093             return(no);
1094             }
1095             EOM
1096              
1097             The syntax used in the file or the one of the config string is
1098             described in L.
1099              
1100             The dynamic setting allows to filter the debug traces when
1101             running. For instance, one can enforce a routine to be silent.
1102              
1103             As an important note, the dynamic configuration is effective only when
1104             the global debug switch is turned on.
1105              
1106             =back
1107              
1108             =head1 LIMITATIONS
1109              
1110             It's not possible to insert tracing hooks like C or C
1111             in stringification overloading routines. For C, that is because
1112             the argument list might be dumped, and printing C<$self> will re-invoke
1113             the stringification routine recursively. For C, this is implied by
1114             the fact that there cannot be any C in the routine, hence C
1115             cannot be used.
1116              
1117             =head1 BUGS
1118              
1119             Please report any bugs to the current maintainer.
1120              
1121             =head1 HISTORY AND CREDITS
1122              
1123             The seed of the C module started to grow in 1996 when
1124             Raphael Manfredi and Christophe Dehaudt were involved in a tricky
1125             project involving kernel environment. It was Christophe's first experience
1126             with I principles. Raphael was already familar with
1127             the concept due to his participation in the development of the
1128             Eiffel compiler.
1129              
1130             Written in C, the first release was based on pre-processor macros. It
1131             already distinguished the pre-conditions, post-conditions and
1132             assertions. Also included were the concepts of dynamic configuration and
1133             flow tracing. The benefit of this lonely include file was very
1134             important since the final integration was very short and, since then,
1135             there has been no major bug reported on the delivered product.
1136              
1137             Based on this first success, they leveraged the techniques for
1138             developments in C++. The debug module was upgraded with the
1139             necessary notions required for true OO programming in C++.
1140              
1141             The Perl module was produced in 2000, when Raphael and Christophe needed
1142             for Perl the same powerful support that they had initiated a few years prior.
1143             Before the first official release in spring 2001, they developed
1144             several other Perl modules and applications (mainly related to CGI
1145             programming) that were powered by C. Some of them have
1146             also been published in CPAN directory (for instance:
1147             C).
1148              
1149             =head1 AUTHORS
1150              
1151             Christophe Dehaudt and Raphael Manfredi are the original authors.
1152              
1153             Send bug reports, hints, tips, suggestions to Dave Hoover at .
1154              
1155             =head1 SEE ALSO
1156              
1157             Carp::Datum::Cfg(3), Carp::Datum::MakeMaker(3), Carp::Datum::Strip(3),
1158             Log::Agent(3).
1159              
1160             =cut
1161