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 give a fabricated example: Before.

sub send_message {
    my ($user_id, $message) = @_;
    ...
    Carp::confess('test');
}

# output:
test at example.pm line 23
    foo('42', 'Hello World') called at example.pl line 5

After.

sub send_message {
    my ($user, $message) = @_;
    ...
    Carp::confess('test');
}

# output:
test at example.pm line 23
    foo('MyApp::Model::User=HASH(0x2c94f68)', 'Hello World') called at example.pl line 5

So now I cannot see which user was passed to foo(), I only see the class name (which is already documented) and some memory address of an object.

I tried to install a stringification operator on the model class using overload.pm:

use overload ( '""' => \&stringify );

sub stringify {
    my ($self) = @_;
    return sprintf '%s[id=%d]', ref($self), $self->id;
}

But this does not affect the longmess. What I would like is something like this:

test at example.pm line 23
    foo('MyApp::Model::User[id=42]', 'Hello World') called at example.pl line 5

That is, the first parameter to foo() should be displayed using the object's stringify() method. How can I achieve that?

Sounds like you want your own [`die()`](http://perldoc.perl.org/functions/die.html) function in which you implement your own backtrace that calls `stringify()` on your objects. I believe you can implement your own `die()` function using the `$SIG{__DIE__}` hook. — PP., Aug 23 '13 at 09:30
@PP. `$SIG{__DIE__}` is arguably broken. Please don't use it. That handler is meant to be called as the last thing before the program exits after a `die`, not as a hook to modify the formatting of error messages. One could override `CORE::GLOBAL::die`, or `use subs 'die'` to implement a custom `die`. Also, this is about `Carp::confess`, not `die`. — amon, Aug 23 '13 at 09:54

amon · Accepted Answer · 2013-08-24T15:29:58.613

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

The previous example was crappy and shoddy work. I updated with bugfixes (e.g. removed the previously hardcoded caller level) — amon, Aug 24 '13 at 15:31

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

1 Answers1

Linked