How can I adjust the rendering of objects in a longmess?

Question

We\'re slowly refactoring our large Perl application towards object-oriented interfaces, especially for data models. The annoying part is that stack traces get less useful. To g

Answer 1

The problem is in this part of Carp.pm:

sub format_arg {
    my $arg = shift;
    if ( ref($arg) ) {
        $arg = defined($overload::VERSION) ? overload::StrVal($arg) : "$arg";
    }
    ...
}

That is, when an argument could be an overloaded object, then any stringification overloading is circumvented with the StrVal helper, which forces default stringification.

Unfortunately, there is no straightforward way around that. All we can do is monkey-patch the Carp::format_arg sub, e.g.

BEGIN {
  use overload ();
  use Carp ();
  no warnings 'redefine';
  my $orig = \&Carp::format_arg;

  *Carp::format_arg = sub {
    my ($arg) = @_;
    if (ref $arg and my $stringify = overload::Method($arg, '""')) {
      $_[0] = $stringify->($arg);
    }
    goto &$orig;
  };
}

As it is, this is inelegant, and should be put into a pragma:

File Carp/string_overloading.pm:

package Carp::string_overloading;

use strict; use warnings;

use overload ();
use Carp ();

# remember the original format_arg method
my $orig = \&Carp::format_arg;
# This package is internal to Perl's warning system.
$Carp::CarpInternal{ __PACKAGE__() }++;

{
    no warnings 'redefine';
    *Carp::format_arg = sub {
        my ($arg) = @_;
        if (    ref($arg)
            and in_effect(1 + Carp::long_error_loc)
            and my $stringify = overload::Method($arg, '""')
        ) {
            $_[0] = $stringify->($arg);
        }
        goto &$orig;
    };
}

sub import   { $^H{__PACKAGE__ . "/in_effect"} = 1 }

sub unimport { $^H{__PACKAGE__ . "/in_effect"} = 0 }

sub in_effect {
    my $level = shift // 1;
    return (caller $level)[10]{__PACKAGE__ . "/in_effect"};
}

1;

Then the code

use strict; use warnings;

package Foo {
    use Carp ();

    use overload '""' => sub {
        my $self = shift;
        return sprintf '%s[%s]', ref $self, join ", ", @$self;
    };

    use Carp::string_overloading;
    sub foo { Carp::confess "as requested" }

    no Carp::string_overloading;
    sub bar { Carp::confess "as requested" }
}

my $foo = bless [1..3] => 'Foo';

eval { $foo->foo("foo") };
print $@;
eval { $foo->bar("bar") };
print $@;

outputs:

as requested at test.pl line 12.
        Foo::foo('Foo[1, 2, 3]', 'foo') called at test.pl line 20
        eval {...} called at test.pl line 20
as requested at test.pl line 15.
        Foo::bar('Foo=ARRAY(0x85468ec)', 'bar') called at test.pl line 22
        eval {...} called at test.pl line 22