Wow - more than 10 years and somehow I missed your reply.
Here is a usage, roughly transcribed from what would happen in the Real World:
my $struct = <<'DEF';
* Some comment
05 AMOUNT VALUE PIC S9(5)V99.
05 VALUE-DATE VALUE PIC X(8).
DEF
my @lines = split /\n/, $struct;
my $buffer = '';
for my $line (@lines) {
next if $line =~ /^ \*/; # comment
$buffer .= $line;
next unless $buffer =~ /\./; # the line did not end, we need more
$buffer =~ /^\s+(\d+)\s+(.+)/;
or croak "Weirdo input found: $buffer";
my( $level, $info) = ($1,$2);
if( $level == 1 ) {
# A record or group, ignore
} elsif ($info !~ /^(\S+)\s*(REDEFINES\s+(\S+))?\s*(PIC\s+[9XS].*?
+\.$/) {
croak "Weirdo info found: $info";
};
my $name = $1;
my $redefine = $2;
my $pic = $3;
my $size = 0;
my $decoder = sub { $_[0] };
if( $pic ) {
($size, $decoder) = PIC::decode_pic($pic,$decimal_separator,$e
+ncoding);
};
# ... use $size and $decoder to read and decode a number of bytes
|