File Coverage

blib/lib/Carp/Always.pm
Criterion Covered Total %
statement 16 25 64.0
branch 1 6 16.6
condition n/a
subroutine 5 9 55.5
pod n/a
total 22 40 55.0


line stmt bran cond sub pod time code
1              
2             package Carp::Always;
3              
4 1     1   58104 use 5.006;
  1         3  
5 1     1   4 use strict;
  1         1  
  1         16  
6 1     1   3 use warnings;
  1         1  
  1         70  
7              
8             our $VERSION = '0.15_01';
9             $VERSION =~ tr/_//d;
10              
11             BEGIN {
12 1     1   14 require Carp;
13 1         292 $Carp::CarpInternal{ +__PACKAGE__ }++;
14             }
15              
16 0     0   0 sub _warn { warn &_longmess }
17              
18 0 0   0   0 sub _die { die ref $_[0] ? @_ : &_longmess }
19              
20             sub _longmess {
21 0     0   0 my $mess = &Carp::longmess;
22 0         0 $mess =~ s/( at .*?\n)\1/$1/s; # Suppress duplicate tracebacks
23 0         0 $mess;
24             }
25              
26             my @HOOKS = qw(__DIE__ __WARN__);
27             my %OLD_SIG;
28              
29             sub import {
30 1     1   9 my $class = shift;
31 1 50       3 return if $OLD_SIG{$class};
32 1         2 @{ $OLD_SIG{$class} }{ @HOOKS, 'Verbose' } = (@SIG{@HOOKS}, $Carp::Verbose);
  1         6  
33              
34 1         11 @SIG{@HOOKS} = ($class->can('_die'), $class->can('_warn'));
35 1         8 $Carp::Verbose = 'verbose'; # makes carp() cluck and croak() confess
36             }
37              
38             sub unimport {
39 0     0     my $class = shift;
40 0 0         return unless $OLD_SIG{$class};
41 0           (@SIG{@HOOKS}, $Carp::Verbose) = @{ delete $OLD_SIG{$class} }{ @HOOKS, 'Verbose' };
  0            
42             }
43              
44             1;
45              
46             =encoding utf8
47              
48             =head1 NAME
49              
50             Carp::Always - Warns and dies noisily with stack backtraces
51              
52             =head1 SYNOPSIS
53              
54             use Carp::Always;
55              
56             Often used on the command line:
57              
58             perl -MCarp::Always script.pl
59              
60             =head1 DESCRIPTION
61              
62             This module is meant as a debugging aid. It can be
63             used to make a script complain loudly with stack backtraces
64             when warn()ing or die()ing.
65              
66             Here are how stack backtraces produced by this module
67             looks:
68              
69             # it works for explicit die's and warn's
70             $ perl -MCarp::Always -e 'sub f { die "arghh" }; sub g { f }; g'
71             arghh at -e line 1
72             main::f() called at -e line 1
73             main::g() called at -e line 1
74              
75             # it works for interpreter-thrown failures
76             $ perl -MCarp::Always -w -e 'sub f { $a = shift; @a = @$a };' \
77             -e 'sub g { f(undef) }; g'
78             Use of uninitialized value in array dereference at -e line 1
79             main::f('undef') called at -e line 2
80             main::g() called at -e line 2
81              
82             In the implementation, the L module does
83             the heavy work, through C. The
84             actual implementation sets the signal hooks
85             L<$SIG{__WARN__}|perlvar/%SIG> and L<$SIG{__DIE__}|perlvar/%SIG> to
86             emit the stack backtraces.
87              
88             Also, all uses of C and C are made verbose,
89             behaving like C and C.
90              
91             =head1 METHODS
92              
93             L implements the following methods.
94              
95             =head2 import
96              
97             Carp::Always->import()
98              
99             Enables L. Also triggered by statements like
100              
101             use Carp::Always;
102             use Carp::Always 0.14;
103              
104             but not by
105              
106             use Carp::Always (); # does not invoke import()
107              
108             =head2 unimport
109              
110             Carp::Always->unimport();
111              
112             Disables L. Also triggered with
113              
114             no Carp::Always;
115              
116             =head1 ACKNOWLEDGMENTS
117              
118             This module was born as a reaction to a release
119             of L by Sébastien Aperghis-Tramoni.
120             Sébastien also has a newer module called
121             L with the same code and fewer flame
122             comments on docs. The pruning of the uselessly long
123             docs of this module was prodded by Michael Schwern.
124              
125             Schwern and others told me "the module name stinked" -
126             it was called C. After thinking long
127             and getting nowhere, I went with nuffin's suggestion
128             and now it is called C.
129              
130             =head1 SEE ALSO
131              
132             L
133              
134             L and L
135              
136             L
137              
138             L
139              
140             L
141              
142             L and L
143              
144             =head1 BUGS
145              
146             =over 4
147              
148             =item *
149              
150             This module does not play well with other modules which fusses
151             around with C, C, C<$SIG{__WARN__}>, C<$SIG{__DIE__}>.
152              
153             =item *
154              
155             Test scripts are good. I should write more of these.
156              
157             =back
158              
159             Please report bugs via GitHub
160             L
161              
162             Backlog in CPAN RT: L
163              
164             =head1 AUTHOR
165              
166             Adriano Ferreira, Eferreira@cpan.orgE
167              
168             =head1 COPYRIGHT AND LICENSE
169              
170             Copyright (C) 2005-2013 by Adriano R. Ferreira
171              
172             This library is free software; you can redistribute it and/or modify
173             it under the same terms as Perl itself.
174              
175             =cut