perl – 如何在longmess中调整对象的渲染?

前端之家收集整理的这篇文章主要介绍了perl – 如何在longmess中调整对象的渲染?前端之家小编觉得挺不错的,现在分享给大家,也给大家做个参考。
我们正在慢慢地将我们的大型Perl应用程序重构为面向对象的接口,特别是对于数据模型.令人讨厌的部分是堆栈跟踪变得不那么有用.举一个捏造的例子:之前.
  1. sub send_message {
  2. my ($user_id,$message) = @_;
  3. ...
  4. Carp::confess('test');
  5. }
  6.  
  7. # output:
  8. test at example.pm line 23
  9. foo('42','Hello World') called at example.pl line 5

后.

  1. sub send_message {
  2. my ($user,$message) = @_;
  3. ...
  4. Carp::confess('test');
  5. }
  6.  
  7. # output:
  8. test at example.pm line 23
  9. foo('MyApp::Model::User=HASH(0x2c94f68)','Hello World') called at example.pl line 5

所以现在我看不到哪个用户传递给foo(),我只看到类名(已经记录)和一个对象的内存地址.

我尝试使用overload.pm在模型类上安装stringification运算符:

  1. use overload ( '""' => \&stringify );
  2.  
  3. sub stringify {
  4. my ($self) = @_;
  5. return sprintf '%s[id=%d]',ref($self),$self->id;
  6. }

但这并不影响长篇大论.我想要的是这样的:

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

也就是说,应该使用对象的stringify()方法显示foo()的第一个参数.我怎样才能做到这一点?

解决方法

问题出现在 Carp.pm的这一部分:
  1. sub format_arg {
  2. my $arg = shift;
  3. if ( ref($arg) ) {
  4. $arg = defined($overload::VERSION) ? overload::StrVal($arg) : "$arg";
  5. }
  6. ...
  7. }

也就是说,当一个参数可能是一个重载对象时,任何字符串化重载都会被StrVal helper规避,这会强制默认字符串化.

不幸的是,没有直截了当的方法.我们所能做的只是修补Carp :: format_arg sub,例如,

  1. BEGIN {
  2. use overload ();
  3. use Carp ();
  4. no warnings 'redefine';
  5. my $orig = \&Carp::format_arg;
  6.  
  7. *Carp::format_arg = sub {
  8. my ($arg) = @_;
  9. if (ref $arg and my $stringify = overload::Method($arg,'""')) {
  10. $_[0] = $stringify->($arg);
  11. }
  12. goto &$orig;
  13. };
  14. }

事实上,这是不优雅的,应该被用于实用主义:

File Carp / string_overloading.pm:

  1. package Carp::string_overloading;
  2.  
  3. use strict; use warnings;
  4.  
  5. use overload ();
  6. use Carp ();
  7.  
  8. # remember the original format_arg method
  9. my $orig = \&Carp::format_arg;
  10. # This package is internal to Perl's warning system.
  11. $Carp::CarpInternal{ __PACKAGE__() }++;
  12.  
  13. {
  14. no warnings 'redefine';
  15. *Carp::format_arg = sub {
  16. my ($arg) = @_;
  17. if ( ref($arg)
  18. and in_effect(1 + Carp::long_error_loc)
  19. and my $stringify = overload::Method($arg,'""')
  20. ) {
  21. $_[0] = $stringify->($arg);
  22. }
  23. goto &$orig;
  24. };
  25. }
  26.  
  27. sub import { $^H{__PACKAGE__ . "/in_effect"} = 1 }
  28.  
  29. sub unimport { $^H{__PACKAGE__ . "/in_effect"} = 0 }
  30.  
  31. sub in_effect {
  32. my $level = shift // 1;
  33. return (caller $level)[10]{__PACKAGE__ . "/in_effect"};
  34. }
  35.  
  36. 1;

然后是代码

  1. use strict; use warnings;
  2.  
  3. package Foo {
  4. use Carp ();
  5.  
  6. use overload '""' => sub {
  7. my $self = shift;
  8. return sprintf '%s[%s]',ref $self,join ",",@$self;
  9. };
  10.  
  11. use Carp::string_overloading;
  12. sub foo { Carp::confess "as requested" }
  13.  
  14. no Carp::string_overloading;
  15. sub bar { Carp::confess "as requested" }
  16. }
  17.  
  18. my $foo = bless [1..3] => 'Foo';
  19.  
  20. eval { $foo->foo("foo") };
  21. print $@;
  22. eval { $foo->bar("bar") };
  23. print $@;

输出

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

猜你在找的Perl相关文章