Perl类关闭

Question

我一直在尝试在perltoot中描述的对象内部创建一个闭包.我已经完全复制了它,甚至复制和粘贴它,但我仍然能够以通常的方式访问该对象,$obj->('NAME').我正盯着失去耐心!

我是误会了什么？我多年来一直在使用perl进行个人项目,并且刚刚开始掌握课程和OOP.

package Person;

sub new {
     my $that  = shift;
     my $class = ref($that) || $that;
     my $self = {
        NAME  => undef,
        AGE   => undef,
        PEERS => [],
     };
     my $closure = sub {
        my $field = shift;
        if (@_) { $self->{$field} = shift }
        return    $self->{$field};
     };
     bless($closure, $class);
     return $closure;
}

sub name   { &{ $_[0] }("NAME",  @_[ 1 .. $#_ ] ) }
sub age    { &{ $_[0] }("AGE",   @_[ 1 .. $#_ ] ) }
sub peers  { &{ $_[0] }("PEERS", @_[ 1 .. $#_ ] ) }

1;

Answer 1

作为一个闭包本身并不会禁止外部调用者的访问，它只是使接口变得更加模糊，使得外部调用者必须做一些额外的跳转才能获取内部状态。

然而，内部状态只能通过闭包访问这一事实意味着您可以在应用访问控制的闭包函数中执行某些操作。

例如，您可以查看caller闭包回调中的返回值，以确保调用闭包的人位于允许的类白名单中。

然后，为了规避这一点，人们必须更加努力地以某种方式将其调用代码列入白名单。

例如，您只需执行以下操作即可使自己看起来在同一个包中：

sub foo {
      package Person; #haha, hax.
      $object->('NAME');
}

这将掩盖[caller]->[0]哪个调用包正在执行代码。

归根结底，没有太多方法可以可靠地隐藏状态，使其难以理解，而且这样做也有些不利。

例如，通过模糊私有访问，您使编写测试变得更加困难，并且使其他人在测试中使用您的代码变得更加困难，因为人们在测试中所做的常见事情是以各种方式调整内部状态以避免依赖于更复杂和不可控的事情。

并且有不止一种方法可以限制对私有值的访问控制

例如，众所周知，我使用Tie::Hash::Method来提供基本的访问控制，例如但不限于：

• 创建/写入/读取预定义列表以外的哈希键时发出警告/死亡
• 不受信任的包访问内部状态时发出警告/死亡

这些技术也可以帮助消除代码错误，而不仅仅是提供访问限制，因为它可以帮助您重构事物并诊断遗留代码在何处仍在使用已弃用的接口。

也许这个相当简单的代码可以给我们一些启发：

use strict;
use warnings;
use utf8;

{

    package Foo;
    use Tie::Hash::Method;
    use Carp qw(croak);
    use Class::Tiny qw(name age), {
        peers => sub { [] }
    };

    sub _access_control {
        my $caller = [ caller(2) ]->[0];
        if ( $caller ne 'Foo' ) {
            local @Foo::CARP_NOT;
            @Foo::CARP_NOT = ( 'Foo', 'Tie::Hash::Method' );
            croak "Private access to hash field >$_[1]<";
        }
    }

    sub BUILD {
        my ( $self, $args ) = @_;
        # return # uncomment for production!
        tie %{$self}, 'Tie::Hash::Method', STORE => sub {
            $self->_access_control( $_[1] );
            return $_[0]->base_hash->{ $_[1] } = $_[2];
          },
          EXISTS => sub {
            $self->_access_control( $_[1] );
            return exists $_[0]->base_hash->{ $_[1] };
          },
          FETCH => sub {
            $self->_access_control( $_[1] );
            return $_[0]->base_hash->{ $_[1] };
          };
    }
}

my $foo = Foo->new();
print qq[has name\n]  if defined $foo->name();
print qq[has age\n]   if defined $foo->age();
print qq[has peers\n] if defined $foo->peers();
$foo->name("Bob");
$foo->age("100");
print $foo->{name};  # Dies here.