Come posso regolare il rendering degli oggetti in un longmess?

Question

Stiamo lentamente rifattorizzando la nostra grande applicazione Perl verso interfacce orientate agli oggetti, in particolare per i modelli di dati. La parte fastidiosa è che le tracce dello stack diventano meno utili. Per dare un esempio fabbricato: Prima.

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 

Dopo.

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 

Così ora non riesco a vedere quale utente è stata passata al foo(), vedo solo il nome della classe (che è già documentata) e qualche indirizzo di memoria di un oggetto.

Ho provato ad installare un operatore di stringa su classe del modello utilizzando overload.pm:

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

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

Ma questo non pregiudica il longmess. Quello che vorrei è qualcosa di simile:

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

Cioè, il primo parametro da foo() deve essere visualizzato utilizzando il metodo dell'oggetto stringify(). Come posso ottenerlo?

Answer 1

Il problema è in questa parte della Carp.pm:

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

Cioè, quando un argomento potrebbe essere un oggetto sovraccarico, quindi un sovraccarico in stringa viene aggirato con la StrVal helper, che costringe in stringa predefinito.

Sfortunatamente, non esiste un modo semplice per aggirarlo. Tutto quello che possiamo fare è utilizzare la patch per scimmia nel sottosuolo Carp::format_arg, ad es.

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; 
    }; 
} 

Orbene, questo è poco elegante, e dovrebbe essere messo in un 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; 

Quindi il codice

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 $@; 

uscite:

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