我们正在慢慢地将我们的大型Perl应用程序重构为面向对象的接口,特别是对于数据模型.令人讨厌的部分是堆栈跟踪变得不那么有用.举一个捏造的例子：之前.
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
后.
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
所以现在我看不到哪个用户传递给foo(),我只看到类名(已经记录)和一个对象的内存地址.
我尝试使用overload.pm在模型类上安装stringification运算符：
use overload ( '""' => \&stringify );
sub stringify {
my ($self) = @_;
return sprintf '%s[id=%d]',ref($self),$self->id;
}
但这并不影响长篇大论.我想要的是这样的：
test at example.pm line 23
foo('MyApp::Model::User[id=42]','Hello World') called at example.pl line 5
解决方法
问题出现在
Carp.pm的这一部分：
sub format_arg {
my $arg = shift;
if ( ref($arg) ) {
$arg = defined($overload::VERSION) ? overload::StrVal($arg) : "$arg";
}
...
}
也就是说,当一个参数可能是一个重载对象时,任何字符串化重载都会被StrVal helper规避,这会强制默认字符串化.
不幸的是,没有直截了当的方法.我们所能做的只是修补Carp :: format_arg sub,例如,
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;
};
}
事实上,这是不优雅的,应该被用于实用主义：
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;
然后是代码
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 $@;
输出：
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