How can I adjust the rendering of objects in a lon

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?

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