/usr/share/perl5/Carp/Always.pm is in libcarp-always-perl 0.12-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 | package Carp::Always;
use 5.006;
use strict;
use warnings;
our $VERSION = '0.12';
use Carp qw(verbose); # makes carp() cluck and croak() confess
sub _warn {
if ($_[-1] =~ /\n$/s) {
my $arg = pop @_;
$arg =~ s/(.*)( at .*? line .*?\n$)/$1/s;
push @_, $arg;
}
warn &Carp::longmess;
}
sub _die {
die @_ if ref($_[0]);
if ($_[-1] =~ /\n$/s) {
my $arg = pop @_;
$arg =~ s/(.*)( at .*? line .*?\n$)/$1/s;
push @_, $arg;
}
die &Carp::longmess;
}
my %OLD_SIG;
BEGIN {
@OLD_SIG{qw(__DIE__ __WARN__)} = @SIG{qw(__DIE__ __WARN__)};
$SIG{__DIE__} = \&_die;
$SIG{__WARN__} = \&_warn;
}
END {
@SIG{qw(__DIE__ __WARN__)} = @OLD_SIG{qw(__DIE__ __WARN__)};
}
1;
__END__
=encoding utf8
=head1 NAME
Carp::Always - Warns and dies noisily with stack backtraces
=head1 SYNOPSIS
use Carp::Always;
makes every C<warn()> and C<die()> complains loudly in the calling package
and elsewhere. More often used on the command line:
perl -MCarp::Always script.pl
=head1 DESCRIPTION
This module is meant as a debugging aid. It can be
used to make a script complain loudly with stack backtraces
when warn()ing or die()ing.
Here are how stack backtraces produced by this module
looks:
# it works for explicit die's and warn's
$ perl -MCarp::Always -e 'sub f { die "arghh" }; sub g { f }; g'
arghh at -e line 1
main::f() called at -e line 1
main::g() called at -e line 1
# it works for interpreter-thrown failures
$ perl -MCarp::Always -w -e 'sub f { $a = shift; @a = @$a };' \
-e 'sub g { f(undef) }; g'
Use of uninitialized value in array dereference at -e line 1
main::f('undef') called at -e line 2
main::g() called at -e line 2
In the implementation, the C<Carp> module does
the heavy work, through C<longmess()>. The
actual implementation sets the signal hooks
C<$SIG{__WARN__}> and C<$SIG{__DIE__}> to
emit the stack backtraces.
Oh, by the way, C<carp> and C<croak> when requiring/using
the C<Carp> module are also made verbose, behaving
like C<cluck> and C<confess>, respectively.
=head2 EXPORT
Nothing at all is exported.
=head1 ACKNOWLEDGMENTS
This module was born as a reaction to a release
of L<Acme::JavaTrace> by Sébastien Aperghis-Tramoni.
Sébastien also has a newer module called
L<Devel::SimpleTrace> with the same code and fewer flame
comments on docs. The pruning of the uselessly long
docs of this module were prodded by Michael Schwern.
Schwern and others told me "the module name stinked" -
it was called C<Carp::Indeed>. After thinking long
and not getting nowhere, I went with nuffin's suggestion
and now it is called C<Carp::Always>.
C<Carp::Indeed> which is now deprecate
lives in its own distribution (which won't go anywhere
but will stay there as a redirection to this module).
=head1 SEE ALSO
=over 4
=item *
L<Carp>
=item *
L<Acme::JavaTrace> and L<Devel::SimpleTrace>
=item *
L<Carp::Always::Color>
=item *
L<Carp::Source::Always>
=back
Please report bugs via CPAN RT
http://rt.cpan.org/NoAuth/Bugs.html?Dist=Carp-Always.
=head1 BUGS
Every (un)deserving module has its own pet bugs.
=over 4
=item *
This module does not play well with other modules which fusses
around with C<warn>, C<die>, C<$SIG{'__WARN__'}>,
C<$SIG{'__DIE__'}>.
=item *
Test scripts are good. I should write more of these.
=item *
I don't know if this module name is still a bug as it was
at the time of C<Carp::Indeed>.
=back
=head1 AUTHOR
Adriano Ferreira, E<lt>ferreira@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2005-2012 by Adriano R. Ferreira
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
|