Если бы я все понял правильно, вы могли бы смотреть на весь текстовый блок построчно.
Используйте регулярное выражение, чтобы проверить, соответствует ли строка шаблону. Захват соответствующих частей. Кэшируйте по крупицам в массиве, содержащем хэши, хранящие детали каждого бита.
Строки буфера, которые не содержат битовый шаблон. Если следует другая строка, которая содержит битовую комбинацию, буфер должен принадлежать последнему биту. Добавьте это там. Все остальные строки должны быть частью общего описания. Примечание: Это не делает различий между любыми дополнительными строками описания для последнего бита. Если такой бит есть, его дополнительные строки станут началом общего описания. (Но вы сказали, что таких вещей нет в ваших данных.)
Подтверждение концепции:
#!/usr/bin/perl
use strict;
use warnings;
my $description_in = 'Bit 6 random description
Bla bla additional line bla bla
bla bla
Bit 5 msg octet 2
Empty line below
Bla bla set to gain instant world domination bla bla
Bit 4-1
Bit 0 msg octet 4
These registers containpart of the Upstream Message.
They should be written only after the cleared by hardware.
Empty line above
Bla bla bla...';
my @bits = ();
my $description_overall = '';
my $line_buffer = '';
foreach my $line (split("\n", $description_in)) {
# if line
# begins with optional white spaces
# followed by "Bit"
# followed by at least one white space
# followed by at least one digit (we capture the digits)
# followed by an optional sequence of optional white spaces, "-", optional white spaces and at least one digit (we capture the digits)
# followed by an optional sequence of at least one white space and any characters (we capture the characters)
# followed by the end of the line
if ($line =~ m/^\s*Bit\s+(\d+)(?:\s*-\s*(\d+))?(?:\s+(.*?))?$/) {
my ($position_begin, $position_end, $description) = ($1, $2, $3);
my $width;
# if there already are bits we've processed
if (scalar(@bits)) {
# the lines possibly buffered belong to the bit before the current one, so append them to its description
$bits[$#bits]->{description} .= (length($bits[$#bits]->{description}) ? "\n" : '') . $line_buffer;
# and reset the line buffer to collect the additional lines of the current bit;
$line_buffer = '';
}
# $position_end is defined only if it was a "Bit n-m"
# otherwise set it to $position_begin
$position_end = defined($position_end) ? $position_end : $position_begin;
$width = abs($position_end - $position_begin) + 1;
# set description to the empty string if not defined (i.e. no description was found)
$description = defined($description) ? $description : '';
# push a ref to a new hash with the keys position, description and width into the list of bits
push(@bits, { position => (sort({$a <=> $b} ($position_begin, $position_end)))[0], # always take the lower position
description => $description,
width => $width });
}
else {
# it's not a bit pattern, so just buffer the line
$line_buffer .= (length($line_buffer) ? "\n" : '') . $line;
}
}
# anything still in the buffer must belong to the overall description
$description_overall .= $line_buffer;
print("<Register>\n <long_description>\n$description_overall\n </long_description>\n");
foreach my $bit (@bits) {
print(" <bit_field position=\"$bit->{position}\" width=\"$bit->{width}\">\n <long_description>\n$bit->{description}\n </long_description>\n </bit_field>\n")
}
print("</Register>\n");
Печать:
<Register>
<long_description>
These registers containpart of the Upstream Message.
They should be written only after the cleared by hardware.
Empty line above
Bla bla bla...
</long_description>
<bit_field position="6" width="1">
<long_description>
random description
Bla bla additional line bla bla
bla bla
</long_description>
</bit_field>
<bit_field position="5" width="1">
<long_description>
msg octet 2
Empty line below
Bla bla set to gain instant world domination bla bla
</long_description>
</bit_field>
<bit_field position="1" width="4">
<long_description>
</long_description>
</bit_field>
<bit_field position="0" width="1">
<long_description>
msg octet 4
</long_description>
</bit_field>
</Register>
Я написал его как отдельный скрипт, чтобы я мог проверить его. Вы должны будете адаптировать его к своему сценарию.
Может быть, добавить некоторую обработку общего описания, исключив эти длинные последовательности пробелов.
Сначала я попытался использовать непрерывный паттерн (while ($x =~ m/^...$/gc)), но это каким-то образом уничтожило окончания строки, в результате чего соответствовало только каждой второй строке. Lookarounds, чтобы удержать их от фактического соответствия, не работал (сказал, что он не реализован; я думаю, мне придется проверить мой Perl на этом компьютере?), Поэтому явное разбиение на строки - это обходной путь .
Возможно также сократить его, используя grep() с, map() с или тому подобное. Но подробная версия лучше демонстрирует идеи, я думаю. Так что я даже не заглядывал в это.