Perl 重载怪异答案

【问题标题】：Perl Overloading WeirdnessPerl 重载怪异
【发布时间】：2018-06-23 05:52:48
【问题描述】：

长话短说：我们想要标记字符串，以便以后我们可以对它们做一些事情，即使它们被嵌入到其他字符串中。

所以我们想，嘿，让我们尝试重载。它很整洁。我可以这样做：

my $str = str::new('<encode this later>');
my $html = "<html>$str</html>";
print $html; # <html><encode this later></html>
print $html->encode; # <html>&lt;encode this later&gt;</html>

它通过重载连接运算符来创建一个新的对象数组，其中包含纯字符串“”、包装对象“”和纯字符串“”。它可以任意嵌套这些。在编码时，它将保留纯字符串，但对对象字符串进行编码。但是，如果你对对象进行字符串化，它只会将其全部作为纯字符串吐出。

这很好用，除了在某些情况下，它会无缘无故地串起来。下面的脚本显示了我在 5.10 到 5.22 中复制的行为。

#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
use Data::Dumper; $Data::Dumper::Sortkeys=1;

my $str1 = str::new('foo');
my $str2 = str::new('bar');

my $good1 = "$str1 $str2";
my $good2;
$good2 = $good1;
my($good3, $good4);
$good3 = "$str1 a";
$good4 = "a $str1";

my($bad1, $bad2, $bad3);
$bad1 = "a $str1 a";
$bad2 = "$str1 $str2";
$bad3 = "a $str1 a $str2 a";

say Dumper { GOOD => [$good1, $good2, $good3], BAD => [$bad1, $bad2, $bad3] };

$bad1 = ''."a $str1 a";
$bad2 = ''."$str1 $str2";
$bad3 = ''."a $str1 a $str2 a";
say Dumper { BAD_GOOD => [$bad1, $bad2, $bad3] };


package str;
use Data::Dumper; $Data::Dumper::Sortkeys=1;

use strict;
use warnings;
use 5.010;

use Scalar::Util 'reftype';

use overload (
    '""'        => \&stringify,
    '.'         => \&concat,
);

sub new {
    my($value) = @_;
    bless((ref $value ? $value : \$value), __PACKAGE__);
} 

sub stringify {
    my($str) = @_;
    #say Dumper { stringify => \@_ };
    if (reftype($str) eq 'ARRAY') {
        return join '', @$str;
    }
    else {
        $$str;
    }
}

sub concat {
    my($s1, $s2, $inverted) = @_;
    #say Dumper { concat => \@_ };
    return new( $inverted ? [$s2, $s1] : [$s1, $s2] );
}

1;

我希望所有这些都被转储为对象，而不是字符串。但是“坏”的例子都是字符串化的。所有“BAD”示例都是当我将我正在连接的字符串对象分配给先前声明的变量时。如果我同时声明，或者之前连接字符串，或者添加额外的连接（超出插值字符串连接），那么它工作正常。

这太疯狂了。

脚本的结果：

$VAR1 = {
    'BAD' => [
        'a foo a',
        'foo bar',
        'a foo a bar a'
    ],
    'GOOD' => [
        bless( [
            bless( [
                bless( do{\(my $o = 'foo')}, 'str' ),
                ' '
            ], 'str' ),
            bless( do{\(my $o = 'bar')}, 'str' )
        ], 'str' ),
        $VAR1->{'GOOD'}[0],
        bless( [
            $VAR1->{'GOOD'}[0][0][0],
            ' a'
        ], 'str' )
    ]
};

$VAR1 = {
    'BAD_GOOD' => [
        bless( [
            '',
            bless( [
                bless( [
                    'a ',
                    bless( do{\(my $o = 'foo')}, 'str' )
                ], 'str' ),
                ' a'
            ], 'str' )
        ], 'str' ),
        bless( [
            '',
            bless( [
                bless( [
                    $VAR1->{'BAD_GOOD'}[0][1][0][1],
                    ' '
                ], 'str' ),
                bless( do{\(my $o = 'bar')}, 'str' )
            ], 'str' )
        ], 'str' ),
        bless( [
            '',
            bless( [
                bless( [
                    bless( [
                        bless( [
                            'a ',
                            $VAR1->{'BAD_GOOD'}[0][1][0][1]
                        ], 'str' ),
                        ' a '
                    ], 'str' ),
                    $VAR1->{'BAD_GOOD'}[1][1][1]
                ], 'str' ),
                ' a'
            ], 'str' )
        ], 'str' )
    ]
};

这种行为对我来说毫无意义。我想了解它为什么会这样工作，并且想找到一种解决方法。

【问题讨论】：

可能的解决方法：p3rl.org/Variable::Magic
Crossposted to PerlMonks，在那里我写了一个回复（因为我第一次看到它）。
我推荐你使用perlbug命令行工具让p5p解释this cleaned up version of your program的结果。包括输出。
@ysth，参见 RT#132793。 Commit 55b62dee2d8dffa7b36b3b613ee4727fbefdb9e3 "仅仅恢复了现有的错误和不一致的 5.26.0 和更早的行为。"
@ysth，关键是这是一个已知的错误，尽管可能没有票。

标签： perl operator-overloading

【解决方案1】：

这不是一个很好的解决方案，也没有回答为什么 perl 会这样做，但我得到了一些东西......我在那里留下了一些调试打印语句。

无论出于何种原因，perl 都认为您希望将对对象的标量引用转换为标量字符串。您可以通过添加对引用的引用然后取消引用来欺骗它不这样做。

#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
use Data::Dumper; $Data::Dumper::Sortkeys=1;
use Scalar::Util 'reftype';

my $str1 = str::new('foo');
my $str2 = str::new('bar');

say 'good1';
my $good1 = "$str1 $str2";
say 'g1 ', reftype($good1);
say Dumper $good1;

say 'bad1';
my $bad1;
say 'b1 ', reftype($bad1);
$bad1 = "$str1 $str2";
say 'b2 ', reftype($bad1);
say Dumper $bad1;

say 'workaround';
my $workaround;
say 'w1 ', reftype($workaround);
$workaround = ${\"$str1 $str2"};
say 'w2 ', reftype($workaround);
say Dumper $workaround;


package str;
use Data::Dumper; $Data::Dumper::Sortkeys=1;

use strict;
use warnings;
use 5.010;

use Scalar::Util 'reftype';

use overload (
    '""'        => \&stringify,
    '.'         => \&concat,
);

sub new {
    my ($value) = @_;
    bless((ref $value ? $value : \$value), __PACKAGE__);
} 

sub stringify {
    my ($str) = @_;

    say "stringify";
    say reftype($str);

    if (reftype($str) eq 'ARRAY') {
        say scalar @$str;
        return join '', @$str;
    }
    else {
        $$str;
    }
}

sub concat {
    my ($s1, $s2, $inverted) = @_;

    say "concat";
    say reftype($s1);
    say reftype($s2);
    say reftype($inverted);

    return new( $inverted ? [$s2, $s1] : [$s1, $s2] );
}

1;

$workaround 为您提供以下内容

$VAR1 = bless( [
                 bless( [
                          bless( do{\(my $o = 'foo')}, 'str' ),
                          ' '
                        ], 'str' ),
                 bless( do{\(my $o = 'bar')}, 'str' )
               ], 'str' );

【讨论】：