Сохранение таблицы транслитерации в perl

Каждый раз, когда вы повторяетесь, вы должны посмотреть, можно ли сделать то, что вы делаете, в цикле. Поскольку tr создает свои таблицы во время компиляции, вы можете использовать eval для доступа к компилятору во время выполнения:

my @trs = (sub {die}, map {eval "sub {\$_[0] =~ tr/${_}0/0$_/}"} 1 .. 8);

my $x = 123;

$trs[2]($x);

print "$x\n"; # 103

Здесь также нет необходимости использовать ссылки, аргументы подпрограммы уже передаются по ссылке.

Если вы не хотите использовать оценку строки, вам нужно использовать конструкцию, которая поддерживает модификацию во время выполнения. Для этого вы можете использовать оператор s///:

sub subst {$_[0] =~ s/($_[1]|0)/$1 ? 0 : $_[1]/ge}

my $z = 1230;

subst $z => 2;

print "$z\n"; # 1032

Конструкция tr/// работает быстрее, чем s///, так как последняя поддерживает регулярные выражения.

Я бы предложил просто отказаться от tr в пользу чего-то, что действительно позволяет немного метапрограммирования, например s///. Например:

# Replace $to_swap with 0 and 0 with $to_swap, and leave
# everything else alone.
sub swap_with_0 {
    my ($digit, $to_swap) = @_;
    if ($digit == $to_swap) {
        return 0;
    } elsif ($digit == 0) {
        return $to_swap;
    } else {
        return $digit;
    }
}

# Swap 0 and $to_swap throughout $string
sub swap_digits {
    my ($string, $to_swap) = @_;
    $string =~ s/([0$to_swap])/swap_with_0($1, $to_swap)/eg;
    return $string;
}

что удивительно просто. :)

Вот короткая подпрограмма, использующая замену вместо транслитерации:

sub swap_digits {
    my ($str, $digit) = @_;
    $str =~ s{ (0) | $digit }{ defined $1 ? $digit : 0 }gex;
    return $str;
}