1

我有一个遗留项目，我想用一些属性和方法扩展其中的几个类。我可以访问源代码并且知道该类使用了祝福的 hashref。我当然可以继续扩展该 hashref，将我想要的键添加到我的类中并重新祝福。但显然这打破了封装，我想尽可能地避免它。

有没有办法以不破坏原始类封装的方式扩展具有属性的（非 Moose）Perl 类，而不仅仅是方法？使用 Moose 执行此操作的选项不可用。谢谢你。

4

1 回答 1

1

首先，基于 hashrefs 编写对象的一个​​最佳实践是在所有字段前面加上包名，例如

package Parent;
sub new {
  my ($class, $x, $y) = @_;
  bless { "Parent::x" => $x, "Parent::y" => $y } => $class;
}
sub x { shift()->{"Parent::x"} }
sub y { shift()->{"Parent::y"} }

在这种情况下，问题不会出现，因为每个类都有自己的属性命名空间。但是谁这样写他的课呢？

我可以想到两种方法来规避任何问题：通过 Autoload 代理原始对象，或使用由内而外的对象模式。第三种解决方案是在您的类中使用前缀属性，并希望父级永远不要使用这些名称。

由内而外的对象

由内而外的对象使用祝福引用作为 ID，并将属性存储在类中的词法变量中：

package Child;
use Scalar::Util qw/refaddr/;
use parent 'Parent';

my %foo;

sub new {
  my ($class, $foo, @args) = @_;
  my $self = $class->SUPER::new(@args);
  $foo{refaddr $self} = $foo;
  return $self;
}

sub foo {
  my ($self) = @_;
  $foo{refaddr $self};
}
sub set_foo {
  my ($self, $val) = @_;
  $foo{refaddr $self} = $val;
}

sub DESTROY {
  my ($self) = @_;
  # remove entries for this object
  delete $foo{refaddr $self};
  $self->SUPER::DESTROY if $self->SUPER::can('DESTROY');
}

这是一个稍微过时的模式，但它非常适合您的用例。

代理对象

我们可以在类的一个字段中包含一个父实例（即 has-a 和 is-a 关系）。每当我们遇到未知方法时，我们都会委托给该对象：

package Child;
use Parent ();
our $SUPER = 'Parent';
use Carp;

sub new {
  my ($class, $foo, @args) = @_;
  bless {
    parent => $SUPER->new(@args),
    foo => $foo,
  } => $class;
}

sub foo {
  my ($self) = @_;
  $self->{foo};
}
sub set_foo {
  my ($self, $val) = @_;
  $self->{foo} = $val;
}

# manually establish pseudo-inheritance

# return true if our class inherits a given package
sub isa {
  my ($self, $class) = @_;
  return !!1 if $class eq __PACKAGE__;
  return +(ref $self ? $self->{parent} : $SUPER)->isa($class);
}

# return a coderef to that method, or false
sub can {
  my ($self, $meth) = @_;

  my %methods = (new => \&new, foo => \&foo, set_foo => \&set_foo, DESTROY => \&DESTROY);
  if (my $code = $methods{$meth}) {
    return $code;
  }

  # check parent
  my $code = ( ref $self ? $self->{parent} : $SUPER)->can($meth);
  return undef unless $code;
  return sub {
    my $self = shift;
    unshift @_, ref $self ? $self->{parent} : $self;
    goto &$code;
  };
}

# write explicit destroy to satisfy autoload
sub DESTROY {
    my ($self) = @_;
    $self->{parent}->DESTROY if ref $self and $SUPER->can('DESTROY');
}

sub AUTOLOAD {
  # fetch appropriate method coderef
  my $meth = our $AUTOLOAD;
  $meth =~ s/.*:://; # clean package name from name
  my $code = $_[0]->can($meth);
  $code or croak qq(Can't locate object method "$meth" via package "@{[__PACKAGE__]}");
  goto &$code;
}

丑陋的部分是在can代码中伪造超类中定义的方法：我们必须将实际方法包装在一个匿名子中，该子将解包我们的对象以调用代理对象上的方法。s 使我们的goto额外级别对被调用的代码不可见，当有人使用caller.

大多数样板代理代码都可以抽象到另一个模块中（并且可能是在 CPAN 上的某个地方）。

于 2013-05-16T07:03:46.090 回答