unpacking a data structure whose first byte indicates length - perl

Question

I am trying to unpack a TLE (Tagged Logical Element) from an IBM AFP format file.
The specification (http://www.afpcinc.org/wp-content/uploads/2017/12/MODCA-Reference-09.pdf) indicates that these are two triplets (even though there are four values) that are structured as follows (with their byte offsets):
0: Tlength | 1: Tid | 2-n: Parameter (= 2: Type + 3: Format + 4-n: EBCDIC encoded String)
Example (with two triplets, one indicating the name and one the value):
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
I use Perl to parse it as follows (and successfully):
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");
}
Result:
'Currency' => 'EUR'
While the above is successful, I feel that my way is a bit too cpmplicated and that there's a more efficient way to do this. E.g. do pack templates support reading the first n bytes to use as a quantifier for how many successive bytes to unpack? I read the Perl pack tutorial but can't seem to find something along those lines.

Answer 1

If the length field didn't include itself, you could do something like the following:
(my $record, $unparsed) = unpack("C/a a*", $unparsed);
my $key = decode("cp500", unpack("x3 a*", $record));
But the length field includes itself.
(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

Please see if following demo code fulfill your requirements.
This code
defines hash decoder subroutines
reads hex representation of bytes provided by OP from DATA block
converts read data into binary representation $data utilizing pack
extracts length, key/tid, type by utilizing unpack
call decoder subroutine for this particular type
gets back hash consisting two arrays keys and vals
forms new hash %data with provided keys and vals
outputs keys and values (returned keys are used to preserve byte/field order)
NOTE: Encode 'from_to' is utilized to decode EBCDIC -- alternative
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
Output
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
Note:
It looks suspicious that val occupies one byte only what gives range of 0..255 for an amount in Euro. Perhaps reserved bytes might be a part of the val amount of Euro.