распаковка структуры данных, первый байт которой указывает длину

Question

Я пытаюсь распаковать TLE (Tagged Logical Element) из файла формата IBM AFP.

В спецификации (http://www.afpcinc.org/wp-content/uploads/2017/12/MODCA-Reference-09.pdf) указано, что это две тройки (хотя Есть четыре значения), которые структурированы следующим образом (с их смещениями байтов ):

0 : Tlength | 1 : Tid | 2-n : параметр (= 2 : тип + 3 : формат + 4-n : EBCDI C закодированная строка)

Пример (с двумя триплетами, один с указанием имени, а другой со значением):

0C 02  0B  00   C3 A4 99 99 85 95 83 A8    07 36  00 00    C5 E4 D9
12 KEY UID CHAR  C  u  r  r  e  n  c  y     7 VAL RESERVED  E  U  R

Я использую Perl, чтобы проанализировать его следующим образом (и успешно):

            if ($key eq 'Data') {
                my $tle = $member->{struct}->{$key};
                my $k_length = hex(unpack('H2', substr($tle, 0, 1)));
                my $key = decode('cp500', substr($tle, 4, $k_length - 4));
                my $v_length = hex(unpack('H2', substr($tle, $k_length, 1)));
                my $value = decode('cp500', substr($tle, $k_length + 4, $v_length - 4));
                print("'$key' => '$value'\n");
            }

Результат:

'Валюта' => 'EUR'

Несмотря на то, что вышеупомянутое успешно, я чувствую, что мой путь слишком сложен и что есть более эффективный способ сделать это. Например, шаблоны pack поддерживают чтение первых n байтов, чтобы использовать их как квантификатор для определения количества последовательных байтов для распаковки? Я прочитал учебник по Perl, но не могу что-то найти в этом направлении.

Answer 1

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

(my $record, $unparsed) = unpack("C/a a*", $unparsed);
my $key = decode("cp500", unpack("x3 a*", $record));

Но поле длины включает себя.

(my $length, $unparsed) = unpack("C a*", $unparsed);
(my $record, $unparsed) = unpack("a".($length-1)." a*", $unparsed);
my $key = decode("cp500", unpack("x3 a*", $record));

Answer 2

Пожалуйста, проверьте, соответствует ли следующий демонстрационный код вашим требованиям.

Этот код

определяет га sh декодер подпрограммы

читает шестнадцатеричное представление байтов, предоставленных OP из DATA block

, преобразует прочитанные данные в двоичное представление $ data , используя pack

извлекает длина , ключ / тид , тип с использованием распаковка

вызов декодер подпрограмма для этого конкретного типа

возвращается ha sh, состоящий из двух массивов ключей и vals

образует новый ха sh % данных с предоставленными ключами и vals

выводит ключи и значения (возвращенные ключи используются для сохранения порядок байтов / полей)

ПРИМЕЧАНИЕ: Кодирование 'from_to' используется для декодирования EBCDI C - альтернатива

use strict;
use warnings;
use feature 'say';

use utf8;
use Encode 'from_to';

my $debug = 1;

my %decoder = ( 
                1 => \&decode_type1,
                2 => \&decode_currency,
                3 => \&decode_type3,
                4 => \&decode_type4,
                5 => \&decode_type5
            );

my $bytes = read_bytes();
my($len,$key,$type) = unpack('C3',$bytes);

my $data = $decoder{$type}($bytes);

my %data;
@data{@{$data->{keys}}} = @{$data->{vals}};

say '
 Unpacked data
---------------';
printf "%-8s => %s\n", $_, $data{$_} for @{$data->{keys}};

sub read_bytes {
    my $hex_bytes = <DATA>;

    chomp $hex_bytes;

    my $bytes = pack('H*',$hex_bytes);

    return $bytes;
}

sub show_bytes {
    my $data = shift;

    print "Bytes: ";
    printf "%02X ", $_ for unpack 'C*', $data;
    print "\n";
}

sub decode_type1 {
    my $bytes = shift;

    return { keys => 'type1', vals => 'vals1' };
}

sub decode_currency {
    my $bytes = shift;

    show_bytes($bytes) if $debug;

    my @keys = qw/length_1 key uid char data_1 length_2 val reserved data_2/;
    my @vals = unpack('C4A8C2SA3',$bytes);

    from_to($vals[4], 'cp37', 'latin1');
    from_to($vals[8], 'cp37', 'latin1');

    return { keys => \@keys, vals => \@vals};
}

sub decode_type3 {
    my $bytes = shift;

    return { keys => 'type3', vals => 'vals3' };
}

sub decode_type4 {
    my $bytes = shift;

    return { keys => 'type4', vals => 'vals4' };
}

sub decode_type5 {
    my $bytes = shift;

    return { keys => 'type5', vals => 'vals5' };
}

__DATA__
0C020B00C3A49999859583A807360000C5E4D9

Выход

Bytes: 0C 02 0B 00 C3 A4 99 99 85 95 83 A8 07 36 00 00 C5 E4 D9

 Unpacked data
---------------
length_1 => 12
key      => 2
uid      => 11
char     => 0
data_1   => Currency
length_2 => 7
val      => 54
reserved => 0
data_2   => EUR

Примечание:

Выглядит подозрительно, что val занимает только один байт, что дает диапазон 0..255 для суммы в евро. Возможно, зарезервированные байты могут быть частью val суммы в евро.