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

对于一个用于教学目的的软件来说，这是一个丑陋的小问题。 new之后的方法很多是模糊不清的。像

这样的东西

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;

<强> program.pl

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

我希望它更清楚。你可以bless只有一个标量引用，但是这通常是对哈希的引用，这里它是对闭包的引用，它是一段代码和数据它在创建封闭时可以访问。

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

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

所有 Perl子例程引用都是闭包，无论相关数据是否有用。这个包含对$data的隐式引用，只要任何包含对该闭包的引用，它就会被维护。所有这些意味着这一行

return $data->{$field};

将引用与$data执行时相同的new，因此散列是持久的，可以通过调用closure子例程来填充和检查它。

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

$person->name('trolley')

执行Person::name($person, 'trolley')，然后从参数数组$person中删除@_并使用特定的第一个参数调用它（因为它是子程序引用），然后复制参数数组的其余部分。与$person->('NAME', 'trolley')一样。

我希望这有助于解决您问题的正确解释。

Answer 2

作为一个闭包本身并不禁止外部呼叫者的访问，它只会使界面更加模糊，使外国呼叫者不得不做一些额外的跳转来获得内部状态。

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

例如，你可以在闭包回调中查看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.

Perl类关闭

2 个答案: