Perl类闭包

我一直在尝试在对象内部创建闭包，如上所述。我已经准确地复制了它，甚至复制并粘贴了它，但我仍然能够以通常的方式访问该对象，

$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;

---

闭包本身并不禁止来自外部调用方的访问，它只会使接口更加模糊，从而使外部调用方不得不进行一些额外的跳转以获取内部状态

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

例如，您可以查看闭包回调中的

caller

的返回值，以确保调用闭包的人在允许的类白名单中

然后，为了避免这种情况，人们必须更努力地挖掘，以使他们的调用代码以某种方式被列入白名单

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

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

这将取决于

[caller]->[0]

哪个调用包正在执行代码

当它进入正题时，没有很多方法可以可靠地隐藏状态，使其不可穿透，这样做也有点不利

例如，通过隐藏私有访问，会使编写测试变得非常困难，也会使其他人更难在测试中使用您的代码，因为人们在测试中经常做的一件事是以各种方式调整内部状态，以避免依赖更复杂和不可控的东西

并且有多种方法限制对私有值的访问控制

例如，我被用来提供基本的访问控制，例如但不限于：

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

这些技术也可以帮助消除代码错误，而不仅仅是提供访问限制，因为它可以帮助您重构东西并诊断遗留代码仍在使用不推荐的接口的地方

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

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.

使用严格；
使用警告；
使用utf8；
{
包装食品；
使用Tie:：Hash:：方法；
使用鲤鱼qw（croak）；
使用Class:：Tiny qw（姓名年龄）{
对等点=>sub{[]}
};
子访问控制{
my$caller=[caller（2）]->[0]；
如果（$ne'Foo'）{
本地@Foo:：CARP\u NOT；
@Foo:：CARP_NOT=（'Foo'，'Tie:：Hash:：Method'）；
croak“私有访问散列字段>$\u[1]对于一个用于教学目的的软件来说，这有点难看。很多晦涩之处在于
新建后的方法

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

是不透明和不必要的。现代的等价物是

sub name {
  my $self = shift;
  $self->('NAME',  @_);
}

还有争议的是，
$self
应该是散列引用，还是我认为应该是的幸运子例程引用

如果我重命名散列引用
$data
（除了闭包代码外，它没有任何名称）和子例程
$self
，那么您可能会看到更容易识别的内容？我还添加了相应的锅炉面板和一些额外的空白

person.pm

use strict;
use warnings;

package Person;

sub new {

  my $class = shift;
  $class = ref($class) || $class;

  my $data = {
    NAME  => undef,
    AGE   => undef,
    PEERS => [],
  };

  my $self = sub {
    my $fname = shift;
    my $field = $data->{$fname};
    $data->{$fname} = shift if @_;
    return $field;
  };

  return bless $self, $class;
}

sub name {
  my $self = shift;
  $self->('NAME', @_);
}

sub age {
  my $self = shift;
  $self->('AGE', @_);
}

sub peers {
  my $self = shift;
  $self->('PEERS', @_);
}

1;

use strict;
use warnings;

use Person;

my $person = Person->new;
$person->name('Jason');
$person->age(23);
$person->peers([qw/ Norbert Rhys Phineas /]);

printf "%s is %d years old.\n", $person->name, $person->age;
my $peers = $person->peers;
print "His peers are: ", join(", ", @$peers), "\n";

program.pl

use strict;
use warnings;

package Person;

sub new {

  my $class = shift;
  $class = ref($class) || $class;

  my $data = {
    NAME  => undef,
    AGE   => undef,
    PEERS => [],
  };

  my $self = sub {
    my $fname = shift;
    my $field = $data->{$fname};
    $data->{$fname} = shift if @_;
    return $field;
  };

  return bless $self, $class;
}

sub name {
  my $self = shift;
  $self->('NAME', @_);
}

sub age {
  my $self = shift;
  $self->('AGE', @_);
}

sub peers {
  my $self = shift;
  $self->('PEERS', @_);
}

1;

use strict;
use warnings;

use Person;

my $person = Person->new;
$person->name('Jason');
$person->age(23);
$person->peers([qw/ Norbert Rhys Phineas /]);

printf "%s is %d years old.\n", $person->name, $person->age;
my $peers = $person->peers;
print "His peers are: ", join(", ", @$peers), "\n";

我希望它更清楚。你可以
只祝福
一个标量引用，但这通常是对散列的引用，这里是对闭包的引用，闭包是一段代码，以及创建闭包时访问的数据

对类的
new
方法的每次调用都会创建并定义一个新的词法变量
$data
。通常，该变量（及其引用的匿名散列）会在子例程末尾超出范围并被删除。但在这种情况下，
new
会返回对调用代码的子例程引用

保留传递的引用取决于调用代码。如果不保留返回的对象，则对任何类的
new
方法的调用都是毫无意义的。在这种情况下，闭包将被删除，因为没有任何东西可以再访问它，而
$data
变量和匿名散列也会因为同样的原因被删除。

所有Perl子例程引用都是闭包，无论关联的数据是否有任何用途。这一引用包含对
$data
的隐式引用，只要有任何东西包含对该闭包的引用，就会保持该引用。这意味着

return $data->{$field};

将引用与执行新
时存在的相同的
$data
，因此哈希是持久的，可以通过调用闭包子例程来填充和检查

所有其他方法都是使用特定的第一个参数从闭包执行子例程

$person->name('trolley')

执行
Person:：name（$Person，'tralley'）
，这将从参数数组
@
中删除
$Person
，并使用特定的第一个参数调用它（因为它是一个子例程引用），并复制参数数组的其余部分。如
$Person->（'name'，'traller'）

我希望这有助于正确解释您的问题。
$obj->（'NAME'）
是访问闭包对象的方式。非闭包对象将使用
$obj->{NAME}
相反，这在这里不起作用。到底是什么问题？@jwodder:我相信OP希望访问
$obj->name
，但是