在 Perl 中隐藏来自用户的领带调用

Question

如何隐藏来自用户的 "tie" 调用，以便调用访问者隐式地为他们执行此操作？

我想这样做，因为我有一个可以被用户访问的数据结构，但是存储在这个结构中的值可以在用户不知情的情况下被修改。

如果数据结构中的属性发生变化，我希望引用该属性的所有变量也被修改，以便用户始终使用新数据。由于用户总是想要新数据，如果用户甚至不需要知道它正在发生，它会更简单、更直观。

这就是我目前所拥有的...虽然它似乎不起作用，但输出是：

hello
hello

我想要的是：

hello
goodbye

代码：

#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

{
    package File;
    use Moose;

    has '_text' => (is => 'rw', isa => 'Str', required => 1);

    sub text {
        my ($self) = @_;
        tie my $text, 'FileText', $self;
        return $text;
    }
}

{
    package FileText;
    use Tie::Scalar;

    sub TIESCALAR {
        my ($class, $obj) = @_;
        return bless $obj, $class;
    }

    sub FETCH {
        my ($self) = @_;
        return $$self->_text();
    }

    sub STORE {
        die "READ ONLY";
    }
}

my $file = 'File'->new('_text' => 'hello');

my $text = $file->text();
say $text;

$file->_text('goodbye');
say $text;

Answer 1

return $text 只是 return 变量的值，而不是变量本身。不过，您可以 return 引用它：

sub text {
    my ($self) = @_;
    tie my $text, 'FileText', $self;
    return $text;
}

然后您必须使用 $$text 取消引用它：

my $file = 'File'->new('_text' => 'hello');

my $text = $file->text();
say $$text;

$file->_text('goodbye');
say $$text;

Answer 2

我不建议这样做。您正在引入 "action at a distance"，这会导致一些非常难以捕获的错误。用户认为他们得到了一个字符串。一个词法字符串只能通过直接和明显地改变它来改变。它必须就地更改或显然传递给函数或附加到某物的引用。

my $text = $file->text;
say $text;  # let's say it's 'foo'

...do some stuff...
$file->text('bar');
...do some more stuff...

# I should be able to safely assume it will still be 'foo'
say $text;

那段代码很容易理解，因为所有可能影响 $text 的东西都是立即可见的。这就是词法上下文的全部意义所在，隔离可以改变变量的内容。

通过 return 可以随时更改的内容，您已经悄悄地打破了这个假设。没有迹象表明用户假设已被打破。当他们去打印 $text 并得到 bar 时，并不明显改变了 $text。整个程序中的任何内容都可能发生变化 $text。那一小段代码现在变得无限复杂。

另一种看待它的方式是：Perl 中的标量变量有一个已定义的接口。该界面的一部分说明了如何更改它们。您正在破坏此界面并向用户撒谎。这就是 overloaded/tied 变量通常被滥用的方式。

无论您试图解决什么问题，您都是通过添加更多问题、通过使代码更复杂和更难理解来解决它。我会退后一步，问你想用搭售解决什么问题。

我要做的只是 return 一个标量引用。这提醒用户可以随时从他们下面更换它。没有魔法可以掩盖一条非常重要的信息。

#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

{
    package File;
    use Moose;

    has 'text_ref' => (
        is              => 'rw',
        isa             => 'Ref',
        default         => sub {
            return \("");
        }
    );

    sub BUILDARGS {
        my $class = shift;
        my %args  = @_;

        # "Cast" a scalar to a scalar ref.
        if( defined $args{text} ) {
            $args{text_ref} = \(delete $args{text});
        }

        return \%args;
    }

    sub text {
        my $self = shift;

        if( @_ ) {
            # Change the existing text object.
            ${$self->text_ref} = shift;
            return;
        }
        else {
            return $self->text_ref;
        }
    }
}

my $file = 'File'->new('text' => 'hello');

my $text = $file->text();
say $$text;

$file->text('goodbye');
say $$text;

就是说，这就是你如何做你想做的。

我不建议使用领带。它非常慢，比方法调用慢得多，有错误而且古怪。它的一个怪癖是绑定的性质附加到变量本身，而不是引用的数据。这意味着你不能 return 绑定变量。

相反，我建议使用重载对象来存储您更改的文本。

{
    package ChangingText;

    # Moose wants class types to be in a .pm file.  We have to explciitly
    # tell it this is a class type.
    use Moose::Util::TypeConstraints qw(class_type);
    class_type('ChangingText');

    use overload
      '""' => sub {
          my $self = shift;
          return $$self;
      },
      fallback => 1;

    sub new {
        my $class = shift;
        my $text = shift;
        return bless $text, $class;
    }

    sub set_text {
        my $self = shift;
        my $new_text = shift;

        $$self = $new_text;

        return;
    }
}

重载的对象有它们自己的注意事项，主要是由于代码需要字符串编写 if !ref $arg 之类的东西，但它们比深层关系错误更容易处理。

为了使其透明，将 ChangingText 对象存储在 File 对象中，然后在其周围放置一个手工制作的 text 访问器来处理纯字符串。访问器确保重用相同的 ChangingText 对象。

为了完成幻觉，BUILDARGS 用于将纯文本初始化参数更改为 ChangingText 对象。

{
    package File;
    use Moose;

    has 'text_obj' => (
        is              => 'rw',
        isa             => 'ChangingText',
        default         => sub {
            return ChangingText->new;
        }
    );

    sub BUILDARGS {
        my $class = shift;
        my %args  = @_;

        # "Cast" plain text into a text object
        if( defined $args{text} ) {
            $args{text_obj} = ChangingText->new(delete $args{text});
        }

        return \%args;
    }

    sub text {
        my $self = shift;

        if( @_ ) {
            # Change the existing text object.
            $self->text_obj->set_text(shift);
            return;
        }
        else {
            return $self->text_obj;
        }
    }
}

然后透明工作。

my $file = File->new('text' => 'hello');

my $text = $file->text();
say $text;  # hello

$file->text('goodbye');
say $text;  # goodbye

在 Perl 中隐藏来自用户的领带调用

Hiding a tie call from the user in Perl

perl

oop

tie