Чтобы ответить на вопрос tr:
%subs = ( '+' => 'PLUS' );
my $pat = join '|', map quotemeta, keys %subs;
s/($pat)/$subs{$1}/g;
Базу 26 можно сделать, но реализовать ее немного сложно и неэффективно, поскольку 26 не является степенью 2. Но это определенно то, что вы хотите. Я посмотрю о кодировании.
А пока вот базовое решение 16:
sub bytes_to_base16 {
my $e = unpack('H*', $_);
$e =~ tr/0123456789ABCDEFabcdef/ABCDEFGHIJKLMNOPKLMNOP/;
return $e;
}
sub base16_to_bytes {
my $e = $_[0];
$e =~ tr/ABCDEFGHIJKLMNOP/0123456789ABCDEF/;
return pack('H*', $_);
}
Посмотрим, насколько эффективна база 26 по сравнению с базой 16:
$ perl -MMath::BigInt -MMath::BigFloat -E'
my $n = Math::BigInt->new(1);
my $bs = 0;
for (1..10) {
$n <<= 8;
++$bs;
my $bd16 = 2*$bs;
my $bd26 = Math::BigFloat->new($n)->blog(26, 5)->bceil->numify;
say sprintf "%2d bytes takes %2d base16 digits or %2d base26 digits.".
" base26 is %3.0f%% of the size of base16.",
$bs, $bd16, $bd26, $bd26/$bd16*100;
}
'
1 bytes takes 2 base16 digits or 2 base26 digits. base26 is 100% of the size of base16.
2 bytes takes 4 base16 digits or 4 base26 digits. base26 is 100% of the size of base16.
3 bytes takes 6 base16 digits or 6 base26 digits. base26 is 100% of the size of base16.
4 bytes takes 8 base16 digits or 7 base26 digits. base26 is 88% of the size of base16.
5 bytes takes 10 base16 digits or 9 base26 digits. base26 is 90% of the size of base16.
6 bytes takes 12 base16 digits or 11 base26 digits. base26 is 92% of the size of base16.
7 bytes takes 14 base16 digits or 12 base26 digits. base26 is 86% of the size of base16.
8 bytes takes 16 base16 digits or 14 base26 digits. base26 is 88% of the size of base16.
9 bytes takes 18 base16 digits or 16 base26 digits. base26 is 89% of the size of base16.
10 bytes takes 20 base16 digits or 18 base26 digits. base26 is 90% of the size of base16.
Эффективная реализация выдаст чуть менее эффективный результат.
$ perl -MMath::BigInt -MMath::BigFloat -E'
my $bs = 0;
for (1..10) {
++$bs;
my $bd16 = 2*$bs;
my $bd26 = int($bs/4)*7 + ($bs%4)*2;
say sprintf "%2d bytes takes %2d base16 digits or %2d base26 digits.".
" base26 is %3.0f%% of the size of base16.",
$bs, $bd16, $bd26, $bd26/$bd16*100;
}
'
1 bytes takes 2 base16 digits or 2 base26 digits. base26 is 100% of the size of base16.
2 bytes takes 4 base16 digits or 4 base26 digits. base26 is 100% of the size of base16.
3 bytes takes 6 base16 digits or 6 base26 digits. base26 is 100% of the size of base16.
4 bytes takes 8 base16 digits or 7 base26 digits. base26 is 88% of the size of base16.
5 bytes takes 10 base16 digits or 9 base26 digits. base26 is 90% of the size of base16.
6 bytes takes 12 base16 digits or 11 base26 digits. base26 is 92% of the size of base16.
7 bytes takes 14 base16 digits or 13 base26 digits. base26 is 93% of the size of base16.
8 bytes takes 16 base16 digits or 14 base26 digits. base26 is 88% of the size of base16.
9 bytes takes 18 base16 digits or 16 base26 digits. base26 is 89% of the size of base16.
10 bytes takes 20 base16 digits or 18 base26 digits. base26 is 90% of the size of base16.
Обратите внимание, что эффективная реализация использует дополнительные цифры для входных данных длиной 7 байтов.
Так стоит ли использовать base26 вместо base16? Вероятно, нет, если каждый байт действительно драгоценен.
И, наконец, вот реализация базы 26.
my @syms = ('A'..'Z');
my %syms = map { $syms[$_] => $_ } 0..$#syms;
sub bytes_to_base26 {
my $e = '';
my $full_blocks = int(length($_[0]) / 4);
for (0..$full_blocks-1) {
my $block = unpack('N', substr($_[0], $_*4, 4));
$e .= join '', @syms[
$block / 26**6 % 26,
$block / 26**5 % 26,
$block / 26**4 % 26,
$block / 26**3 % 26,
$block / 26**2 % 26,
$block / 26**1 % 26,
$block / 26**0 % 26,
];
}
my $extra = substr($_[0], $full_blocks*4);
for my $block (unpack('C*', $extra)) {
$e .= join '', @syms[
$block / 26**1 % 26,
$block / 26**0 % 26,
];
}
return $e;
}
sub base26_to_bytes {
my $d = '';
my $full_blocks = int(length($_[0]) / 7);
for (0..$full_blocks-1) {
my $block = 0;
$block = $block*26 + $syms{$_} for unpack '(a)*', substr($_[0], $_*7, 7);
$d .= pack('N', $block);
}
my $extra = substr($_[0], $full_blocks*7);
my @extra = unpack('(a)*', $extra);
while (@extra) {
my $block = 0;
$block = $block*26 + $syms{ shift(@extra) };
$block = $block*26 + $syms{ shift(@extra) };
$d .= pack('C', $block);
}
return $d;
}