Perl Перегружающая странность - программирование

Короче говоря: мы хотим отметить строки, чтобы потом мы могли что-то с ними сделать, даже если они встроены в другие строки.

Поэтому мы решили, эй, попробуй перегрузить. Это довольно аккуратно. Я могу сделать что-то вроде:

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>

Он делает это, перегружая оператор конкатенации, чтобы создать новый массив объектов с простой строкой "<html>", обертывание объекта "<encode this later>" и простая строка "</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" все стробированы. Все примеры "BAD" - это когда я назначаю строковый объект, который я конкатенирую в настоящий момент, перед ранее объявленной переменной. Если я объявляю в одно и то же время или объединяю строки ранее или добавляю дополнительную конкатенацию (за интерполированной строкой concat), тогда она отлично работает.

Это орехи.

Результат скрипта:

$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' )
    ]
};

Поведение не имеет для меня никакого смысла. Я хотел бы понять, почему он работает таким образом, и я хотел бы найти обходное решение.

Ответ 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;

$ обходным путем вы получаете следующее

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