}
}
-our $VERSION = '1.30';
+our $VERSION = '1.31';
our $MaxEvalLen = 0;
our $Verbose = 0;
our $CarpLevel = 0;
our $MaxArgLen = 64; # How much of each argument to print. 0 = all.
our $MaxArgNums = 8; # How many arguments to print. 0 = all.
+our $RefArgFormatter = undef; # allow caller to format reference arguments
require Exporter;
our @ISA = ('Exporter');
}
# Transform an argument to a function into a string.
+our $no_recurse;
sub format_arg {
my $arg = shift;
+ die "recursion\n" if $no_recurse;
+
if ( ref($arg) ) {
- $arg = defined($overload::VERSION) ? overload::StrVal($arg) : "$arg";
+ local $SIG{__DIE__} = sub{}; # legitimate, let's not leak it.
+ if (do {
+ local $@;
+ eval {$arg->can('CARP_TRACE') }
+ })
+ {
+ $arg = $arg->CARP_TRACE();
+ }
+ elsif (do {
+ local $@;
+ eval {$arg = $RefArgFormatter->($arg); 1}
+ })
+ {
+ 1;
+ }
+ elsif (defined($overload::VERSION))
+ {
+ do {
+ local $@;
+ eval {
+ local $no_recurse = 1;
+ $arg = "$arg";
+ 1;
+ }
+ } or do {
+ $arg = overload::StrVal($arg);
+ };
+ }
+ else
+ {
+ $arg = "$arg";
+ }
}
if ( defined($arg) ) {
$arg =~ s/'/\\'/g;
Alternately, you can set the global variable C<$Carp::Verbose> to true.
See the C<GLOBAL VARIABLES> section below.
+=head2 Stack Trace formatting
+
+At each stack level, the subroutine's name is displayed along with
+its parameters. For simple scalars, this is sufficient. For complex
+data types, such as objects and other references, this can simply
+display C<'HASH(0x1ab36d8)'>.
+
+Carp gives three ways to control this.
+
+=over 4
+
+=item 1.
+
+For objects, a method, C<CARP_TRACE>, will be called, if it exists. If
+this method doesn't exist, or it recurses into C<Carp>, or it otherwise
+throws an exception, this is skipped, and Carp moves on to the next option,
+otherwise checking stops and the string returned is used. It is recommended
+that the object's type is part of the string to make debugging easier.
+
+=item 2.
+
+For any type of reference, C<$Carp::RefArgFormatter> is checked (see below).
+This variable is expected to be a code reference, and the current parameter
+is passed in. If this function doesn't exist (the variable is undef), or
+it recurses into C<Carp>, or it otherwise throws an exception, this is
+skipped, and Carp moves on to the next option, otherwise checking stops
+and the string returned is used.
+
+=item 3.
+
+The reference is stringified. If overloading is being used on the object,
+that overloading is called. If that overload recurses into C<Carp>, or it
+otherwise throws an exception, this is skipped, and Carp moves on to the next
+option, otherwise checking stops and the string returned is used.
+
+=item 4.
+
+To get this far, L<overload> must be loaded because the object failed
+to stringify normally. L<overload>::StrVal is called to stringify the
+object without any overloading to produce a value where all of the above
+has failed.
+
+=back
+
=head1 GLOBAL VARIABLES
=head2 $Carp::MaxEvalLen
Defaults to C<0>.
+=head2 $Carp::RefArgFormatter
+
+This variable sets a general argument formatter to display references.
+Plain scalars and objects that implement C<CARP_TRACE> will not go through
+this formatter. Calling C<Carp> from within this function is not supported.
+
+local $Carp::RefArgFormatter = sub {
+ require Data::Dumper;
+ Data::Dumper::Dump($_[0]); # not necessarily safe
+};
+
=head2 @CARP_NOT
This variable, I<in your package>, says which packages are I<not> to be
--- /dev/null
+use warnings;
+no warnings 'once';
+use Test::More 0.98 tests => 9;
+
+use Carp;
+
+my $o = Stringable->new(key => 'Baz');
+
+my $msg = call(\&with_longmess, $o, {bar => 'buzz'});
+like($msg, qr/'Stringable=Baz'/, "Stringable object stringified");
+like($msg, qr/'HASH\(0x[[:xdigit:]]+\)'/, "HASH *not* stringified");
+
+{
+ my $called;
+
+ local $Carp::RefArgFormatter = sub {
+ $called++;
+ join '', explain $_[0];
+ };
+
+ $msg = call(\&with_longmess, $o, {bar => 'buzz'});
+ ok($called, "Called private formatter");
+ like($msg, qr/bar.*buzz/m, 'HASH stringified');
+}
+
+$o = CarpTracable->new(key => 'Bax');
+$msg = call(\&with_longmess, $o, {bar => 'buzz'});
+ok($o->{called}, "CARP_TRACE called");
+like($msg, qr/'TRACE:CarpTracable=Bax'/, "CARP_TRACE output used") or diag explain $msg;
+like($msg, qr/'HASH\(0x[[:xdigit:]]+\)'/, "HASH not stringified again");
+
+$o = CarpBad->new(key => 'Zoo');
+$msg = call(\&with_longmess, $o, {bar => 'kill'});
+unlike($msg, qr/THIS SHOULD NEVER HAPPEN|Zoo/, "Didn't get the as-string version");
+like($msg, qr/CarpBad=HASH/,"Normal non-overload string conversion");
+diag explain $msg;
+
+sub call
+{
+ my $func = shift;
+ $func->(@_);
+}
+
+sub with_longmess
+{
+ my $g = shift;
+ Carp::longmess("longmess:\n");
+}
+
+package Stringable;
+
+use overload
+ q[""] => 'as_string';
+
+sub new { my $class = shift; return bless {@_}, $class }
+
+sub as_string
+{
+ my $self = shift;
+ join '=', ref $self, $self->{key} || '<no key>';
+}
+
+package CarpTracable;
+
+use parent -norequire => 'Stringable';
+
+sub CARP_TRACE
+{
+ my $self = shift;
+ $self->{called}++;
+ "TRACE:" . $self; # use string overload
+}
+
+package CarpBad;
+
+use parent -norequire => 'Stringable';
+
+sub as_string
+{
+ Carp::cluck("woops, this isn't allowed");
+ "THIS SHOULD NEVER HAPPEN";
+}
+
+
projects / platform / upstream / perl.git / commitdiff