将新方法添加到 perl 中的现有对象

Question

我有这个 perl 对象。实例化对象后，我试图在加载程序方法中向对象添加一个新方法，稍后可以调用该方法。

我已经尝试了一大堆没有用的东西。示例包括：

sub loader {
    my ($self) = @_;

    sub add_me {
        my ($self, $rec) = @_

        warn "yayyyyyy";
        return $rec;
    }

    #here are the things I've tried that dont work:
    # &{$self->{add_me}} = \&add_me;
    # \&{$self->{add_me}} = \&add_me;
    # assuming the class definition is in Holder::Class try to add it to symblol table
    # *{Holder::Class::add_me} = \&add_me;

}

编辑：

我需要这样做的原因是我在我的代码中添加了一个钩子，我的软件的用户将能够注入他们自己的子程序来随意编辑数据结构。

为此，他们将能够编辑仅包含一个子文件的辅助文件，并获取传入的相关数据结构，例如：

sub inject_a_sub {
    my ($self, $rec) = @_;

    #do stuff to $rec

    return $rec;
}

然后在我的原始对象实例化时，我检查上面提到的文件是否存在，如果存在，读取它的内容并评估它们。最后，我想制作一个 sub 的 eval'd 代码，一个我的对象的方法。准确地说，我的对象已经继承了一个名为 do_something 的方法，我想让 eval 读入的 sub 覆盖继承的 do_something 方法，以便在从外部文件调用 sub 时运行.

这是一个奇怪的问题：/

它伤害了我:(

欧比旺克诺比你是我唯一的希望！

干杯！

Answer 1

如果您只想将功能附加到特定对象，而不需要继承，您可以在对象中存储一个代码引用并调用它。

# Store the code in the object, putting it in its own
# nested hash to reduce the chance of collisions.
$obj->{__actions}{something} = sub { ... };

# Run the code
my @stuff = $obj->{__actions}{something}->(@args);

问题是，您需要检查 $obj->{__actions}{something} 是否包含代码引用。我的建议是围绕这个过程包装一个方法。

sub add_action {
    my($self, $action, $code) = @_;

    $self->{__actions}{$action} = $code;

    return;
}

sub take_action {
    my($self, $action, $args) = @_;

    my $code = $self->{__actions}{$action};
    return if !$code or ref $code ne 'CODE';

    return $code->(@$args);
}

$obj->add_action( "something", sub { ... } );
$obj->take_action( "something", \@args );

如果您已经知道要向其中注入方法的 class 名称，请照常编写子例程，但使用完全限定名称。

sub Some::Class::new_method {
    my $self = shift;

    ...
}

请注意，该子例程内的任何全局变量都将位于周围的包中，而不是 Some::Class。如果您想要持久变量，请在子例程内使用 state 或在子例程外使用 my。

如果您在编译时不知道名称，则必须将子例程注入符号 table，所以您已经接近最后一个了。

sub inject_method {
    my($object, $method_name, $code_ref) = @_;

    # Get the class of the object
    my $class = ref $object;

    {
        # We need to use symbolic references.
        no strict 'refs';

        # Shove the code reference into the class' symbol table.
        *{$class.'::'.$method_name} = $code_ref;
    }

    return;
}

inject_method($obj, "new_method", sub { ... });

Perl 中的方法与 class 而不是对象相关联。为了将方法分配给单个对象，您必须将该对象放入其自己的 class 中。与上面类似，但是你必须为每个实例创建一个subclass。

my $instance_class = "_SPECIAL_INSTANCE_CLASS_";
my $instance_class_increment = "AAAAAAAAAAAAAAAAAA";
sub inject_method_into_instance {
    my($object, $method_name, $code_ref) = @_;

    # Get the class of the object
    my $old_class = ref $object;

    # Get the special instance class and increment it.
    # Yes, incrementing works on strings.
    my $new_class = $instance_class . '::' . $instance_class_increment++;

    {
        # We need to use symbolic references.
        no strict 'refs';

        # Create its own subclass
        @{$new_class.'::ISA'} = ($old_class);

        # Shove the code reference into the class' symbol table.
        *{$new_class.'::'.$method_name} = $code_ref;

        # Rebless the object to its own subclass
        bless $object, $new_class;
    }

    return;
}

我省略了代码，通过检查实例的 class 是否与 /^${instance_class}::/ 匹配来检查实例是否已经进行了这种处理。我把它留给你作为练习。为每个对象创建一个新的 class 并不便宜，而且会占用内存。

这样做有充分的理由，但它们是例外的。你真的应该质疑你是否应该做这种 monkey patching. In general, action at a distance 应该避免的事情。

你能使用子class、委派或角色来完成同样的事情吗？

已经存在 Perl OO 系统可以为您做这件事以及更多。你应该使用一个。 Moose, Moo (via Role::Tiny) and Mouse 都可以给一个实例添加角色。

将新方法添加到 perl 中的现有对象

Add new method to existing object in perl

oop

perl