perl - сопоставление в четных позициях и удаление непечатаемых символов

Question

У меня есть шестнадцатеричная строка из дампа таблицы базы данных, похожая на

"41424320202020200A200B000C"

что я хочу сделать, это сопоставить в четных позициях и обнаружить контрольные символы, которые могут разбить строку при печати .. т.е. удалить ноль ascii \ x00, \ n, \ r, \ f и \ x80 в \ xFF и т. д.

Я пытался удалить ascii null, как

perl -e ' $x="41424320202020200A200B000C"; $x=~s/00//g; print "$x\n" '

но результат неверен, поскольку он удалил 0 из конечного шестнадцатеричного значения пробела \ x20 и приводит 0 к новой строке \ x0A, т.е. 20 0A к 2A

414243202020202A2B0C

что я хотел, это

414243202020202020

Answer 1

Можно работать напрямую с шестнадцатеричной формой символов, но это намного сложнее. Я рекомендую против использования этого подхода. Этот ответ служит иллюстрацией того, почему это решение не было предложено.

---

Вы хотите исключить все символы, кроме следующих:

• ASCII печатные формы (20 ₁₆ до 7E ₁₆ )
• TAB (09 ₁₆ )

Это означает, что вы хотите исключить следующие символы:

• 00 ₁₆ до 08 ₁₆
• 0A ₁₆ до 1F ₁₆
• 7F ₁₆ до FF ₁₆

Если мы сгруппируем их по старшим цифрам, мы получим

• 00 ₁₆ до 08 ₁₆ , 0A ₁₆ до 0F ₁₆
• 10 ₁₆ до 1F ₁₆
• 7F ₁₆
• 80 ₁₆ до FF ₁₆

Поэтому мы можем использовать следующее:

$hex =~ s/\G(?:..)*?\K(?:0[0-8A-Fa-f]|7F|[189A-Fa-f].)//sg;     # 5.10+

$hex =~ s/\G((?:..)*?)(?:0[0-8A-Fa-f]|7F|[189A-Fa-f].)/$1/sg;   # Slower

Answer 2

обнаружение контрольных символов, которые могут привести к разрыву строки при печати. ​​Т.е. удалить ноль ascii \ x00, \ n, \ r, \ f и \ x80 в \ xFF и т. Д.

Опираясь на ответ Хакона (который удаляет только нулевые байты, а не все остальные):

#!/usr/bin/perl
use warnings;
use strict;
use feature qw/say/;
my $x="41424320202020200A200B000C";
say $x;
say grep { chr(hex($_)) =~ /[[:print:]\t]/ && hex($_) < 128 } unpack("(A2)*", $x);

дает вам

41424320202020200A200B000C
414243202020202020

Класс символов [:print:] внутри набора символов соответствует всем печатным символам, включая пробел (но не управляющим символам, таким как перевод строки и перевод строки), и я также добавил их на вкладку. Затем он также проверяет, находится ли байт в диапазоне ASCII (поскольку во многих локалях по-прежнему можно печатать старшие символы).

Answer 3

say unpack("H*", pack("H*", "41424320202020200A200B000C") =~ s/[^\t[:print:]]//arg);

или

my $hex = "41424320202020200A200B000C";
my $bytes = pack("H*", $hex);
$bytes =~ s/[^\t[:print:]]//ag;
$hex = unpack("H*", $bytes);
say $hex;

или

my $hex = "41424320202020200A200B000C";
my $bytes = pack("H*", $hex);
$bytes =~ s/[^\t\x20-\x7E]//g;
$hex = unpack("H*", $bytes);
say $hex;

Решения, использующие /a и /r, требуют Perl 5.14 +.

---

Сказанное начинается со следующей строки:

 41424320202020200A200B000C

Преобразуется в следующее с помощью pack:

 ABC␠␠␠␠␠␊␠␋␀␌

Подстановка удаляет все не-ASCII и все непечатаемые символы, кроме TAB, оставляя нам следующее:

 ABC␠␠␠␠␠␠

Преобразуется в следующее с помощью unpack:

 414243202020202020

---

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

Answer 4

Вы можете попробовать разбить строку на 2-байтовые подстроки, используя unpack:

my $x="41424320202020200A200B000C";
say $x;
say join '', grep { $_ !~ /00/} unpack "(A2)*", $x;

выход

41424320202020200A200B000C
41424320202020200A200B0C