184 lines
4.1 KiB
Perl
184 lines
4.1 KiB
Perl
|
|
package Carp::Always;
|
|
|
|
use 5.006;
|
|
use strict;
|
|
use warnings;
|
|
|
|
our $VERSION = '0.16';
|
|
$VERSION =~ tr/_//d;
|
|
|
|
BEGIN {
|
|
require Carp;
|
|
$Carp::CarpInternal{ +__PACKAGE__ }++;
|
|
}
|
|
|
|
use constant CHOMP_DOT => $Carp::VERSION < 1.25;
|
|
|
|
sub _warn { warn &_longmess }
|
|
|
|
sub _die { die ref $_[0] ? @_ : &_longmess }
|
|
|
|
sub _longmess {
|
|
if (CHOMP_DOT && $_[-1] =~ /\.\n\z/) {
|
|
my $arg = pop @_;
|
|
$arg =~ s/\.\n\z/\n/;
|
|
push @_, $arg;
|
|
}
|
|
my $mess = &Carp::longmess;
|
|
$mess =~ s/( at .*?\n)\1/$1/s; # Suppress duplicate tracebacks
|
|
$mess;
|
|
}
|
|
|
|
my @HOOKS = qw(__DIE__ __WARN__);
|
|
my %OLD_SIG;
|
|
|
|
sub import {
|
|
my $class = shift;
|
|
return if $OLD_SIG{$class};
|
|
@{ $OLD_SIG{$class} }{ @HOOKS, 'Verbose' } = (@SIG{@HOOKS}, $Carp::Verbose);
|
|
|
|
@SIG{@HOOKS} = ($class->can('_die'), $class->can('_warn'));
|
|
$Carp::Verbose = 'verbose'; # makes carp() cluck and croak() confess
|
|
}
|
|
|
|
sub unimport {
|
|
my $class = shift;
|
|
return unless $OLD_SIG{$class};
|
|
no if "$]" <= 5.008008, 'warnings' => 'uninitialized';
|
|
(@SIG{@HOOKS}, $Carp::Verbose) = @{ delete $OLD_SIG{$class} }{ @HOOKS, 'Verbose' };
|
|
}
|
|
|
|
1;
|
|
|
|
=encoding utf8
|
|
|
|
=head1 NAME
|
|
|
|
Carp::Always - Warns and dies noisily with stack backtraces
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Carp::Always;
|
|
|
|
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 L<Carp> module does
|
|
the heavy work, through C<longmess()>. The
|
|
actual implementation sets the signal hooks
|
|
L<$SIG{__WARN__}|perlvar/%SIG> and L<$SIG{__DIE__}|perlvar/%SIG> to
|
|
emit the stack backtraces.
|
|
|
|
Also, all uses of C<carp> and C<croak> are made verbose,
|
|
behaving like C<cluck> and C<confess>.
|
|
|
|
=head1 METHODS
|
|
|
|
L<Carp::Always> implements the following methods.
|
|
|
|
=head2 import
|
|
|
|
Carp::Always->import()
|
|
|
|
Enables L<Carp::Always>. Also triggered by statements like
|
|
|
|
use Carp::Always;
|
|
use Carp::Always 0.14;
|
|
|
|
but not by
|
|
|
|
use Carp::Always (); # does not invoke import()
|
|
|
|
=head2 unimport
|
|
|
|
Carp::Always->unimport();
|
|
|
|
Disables L<Carp::Always>. Also triggered with
|
|
|
|
no Carp::Always;
|
|
|
|
=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 was prodded by Michael Schwern.
|
|
|
|
Schwern and others told me "the module name stinked" -
|
|
it was called C<Carp::Indeed>. After thinking long
|
|
and getting nowhere, I went with nuffin's suggestion
|
|
and now it is called C<Carp::Always>.
|
|
|
|
=head1 SEE ALSO
|
|
|
|
L<Carp>
|
|
|
|
L<Acme::JavaTrace> and L<Devel::SimpleTrace>
|
|
|
|
L<Carp::Always::Color>
|
|
|
|
L<Carp::Source::Always>
|
|
|
|
L<Devel::Confess>
|
|
|
|
L<Carp::Always::SyntaxHighlightSource> and L<Carp::Always::DieOnly>
|
|
|
|
=head1 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.
|
|
|
|
=back
|
|
|
|
Please report bugs via GitHub
|
|
L<https://github.com/aferreira/cpan-Carp-Always/issues>
|
|
|
|
Backlog in CPAN RT: L<https://rt.cpan.org/Public/Dist/Display.html?Name=Carp-Always>
|
|
|
|
=head1 AUTHOR
|
|
|
|
Adriano Ferreira, E<lt>ferreira@cpan.orgE<gt>
|
|
|
|
=head1 COPYRIGHT AND LICENSE
|
|
|
|
Copyright (C) 2005-2013, 2018 by Adriano Ferreira
|
|
|
|
This library is free software; you can redistribute it and/or modify
|
|
it under the same terms as Perl itself.
|
|
|
|
=cut
|