Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

How to read variable data length ?

by bh_perl (Monk)
on Jul 29, 2010 at 04:03 UTC ( #851843=perlquestion: print w/replies, xml ) Need Help??

bh_perl has asked for the wisdom of the Perl Monks concerning the following question:

Hi..

I have a sample binary sample files begin file header (fixed length record) and data record (variable length record).

Sample data file as below:-

84 47 00 0c 00 00 11 0a 03 50 35 04 00 64 0a 04 16 12 00 1e 00 1d 00 00 65 09 08 54 52 03 2f 82 05 10 00 02 6e 06 0b a8 53 11 67 00 00 00 7a 7f 00 69 4a 42 47 48 4a 41 0c 00 6a 53 54 4d 44 54 4f 1c 00 66 04 00 00 84 43 00 0c 00 00 11 09 08 43 49 29 60 64 0a 04 16 12 00 21 00 1b 00 00 65 09 08 44 80 90 0f 82 05 10 00 04 6e 06 08 ac 9b 02 67 00 00 00 7a 7f 00 69 53 54 4d 44 54 49 1f 00 6a 4b 43 47 48 51 42 3d 00

Based on sample file the header will be

<code 84 47 00 0c 00 00 11 0a 03 50 35 04 00 </code>

While the data record will be

64 0a 04 16 12 00 1e 00 1d 00 00 65 09 08 54 52 03 2f 82 05 10 00 02 6e 06 0b a8 53 11 67 00 00 00 7a 7f 00 69 4a 42 47 48 4a 41 0c 00 6a 53 54 4d 44 54 4f 1c 00 66 04 00 00 84 43 00 0c 00 00 11 09 08 43 49 29 60 64 0a 04 16 12 00 21 00 1b 00 00 65 09 08 44 80 90 0f 82 05 10 00 04 6e 06 08 ac 9b 02 67 00 00 00 7a 7f 00 69 53 54 4d 44 54 49 1f 00 6a 4b 43 47 48 51 42 3d 00

The variable length data contain TAG, LENGTH and DATA. Due to that i have to read the data length in order to get the real records. Below is my coding

#!/usr/bin/perl -w use Cwd; use warnings; use strict; use Getopt::Long; use Switch; use constant FILEHDR => 4; use constant CDRLEN => 286; my ($trace, $help, $infile); my $swap = ''; my $indir = getcwd; my $outdir = getcwd; GetOptions ( "h|help" => \$help, "filename|f=s" => \$infile, "swap|s" => \$swap, "input|i=s" => \$indir, "output|o=s" => \$outdir, "trace|t" => \$trace ) or usage(); sub usage { exit; } my @tt = ("Flags", "Record Seq.", "LAC Length", "Directory No", "Other +s"); my @dtf = ("Year","Month","Day","Hour","Minute","Second", "Reserved"," +Duration"); my $outfile = $infile; my $data; my $i; sub inttohex { my $int = shift; return sprintf ("%02X", $int); } sub hextoint { my $hex = shift; return sprintf ("%d", hex($hex)); } ## Convert each ASCII character to a two-digit hex number. sub asctohex () { (my $hex = shift) =~ s/(.|\n)/sprintf("%02lx", ord $1)/eg; return $hex; } # Convert each two-digit hex number back to an ASCII character. sub hextoasc { (my $asc = shift) =~ s/([a-fA-F0-9]{2})/chr(hex $1)/eg; return $asc; } sub strtoasc { my $str = shift; my $asc = ""; my $loc = 0; my $i; for ($i = 0; $i < length($str); $i+=2) { $asc = $asc . hextoasc(substr($str, $loc, 2)); $loc = $loc + 2; } return $asc; } my ($partnerdir_no); if ($infile) { #open (OUTPUT, ">$outdir/$outfile"); open (DATA, "$indir/$infile"); binmode DATA; my @rec; until (eof DATA) { read (DATA, $data, 2); my $tag = unpack "H2", substr $data,0,1,''; my $length = unpack "C", substr $data,0,1,''; $length -= 2; if ($length == "81") { $length = unpack "C", substr $data,0,1,''; $length -= 1; } my $loc = 0; while (read (DATA, $data, $length)) { my @header = unpack "H6 H2 H2 H12", substr $data,0,11,''; if ($trace) { printf ("%-20s : %-5s >%s<\n", "TAG" , $tag, inttohex( +$tag)); printf ("%-20s : %-5s >%s<\n", "RECORD LENGTH", $lengt +h+2, inttohex($length+2)); printf ("HEADER\n"); for ($i=0; $i<@header; $i++) { printf (" |- %-16s : %s\n", $tt[$i],$header[$i]); } } printf ("\nDATA PACKAGE\n"); while ($data) { $tag = unpack "C", substr $data,$loc,1,''; printf ("%-20s : %-5s >%s<\n", "TAG", $tag, inttohex($ +tag)); switch ($tag) { # x64 - length fix 11 bytes case 100 { @rec = unpack "C C C C C C C C3", subst +r $data,0,10; printf " |- DateTime/Duration\n"; for (my $i=0; $i<8; $i++) { printf " |- %-20s : %02s >%s<\n", $dt +f[$i], $rec[$i], inttohex($rec[$i]); } } # x65 case 101 { my $length = unpack "C", substr $data,0 +,1,''; $length += 1; if ($length == "81") { $length = unpack "C", substr $data,0,1,''; $length += 1; } $partnerdir_no = unpack "H*", substr $data,0 +,$length; printf ("PARTNER DIRECTORY NO. : %s\n", $par +tnerdir_no); } } } } } close(DATA); #close(OUTPUT); }

But, my program read twice on the variable part ?. Why this is happened ?.. is it my coding is wrong ?.. please help me..

Thank you,

Replies are listed 'Best First'.
Re: How to read variable data length ?
by roboticus (Chancellor) on Jul 29, 2010 at 04:28 UTC

    bh_perl:

    The second read is the condition of a while loop, so it's going to run it again. If you want it to read only once, don't put it in a loop. Your until loop should be sufficient to read all the records.

    ...roboticus

Re: How to read variable data length ?
by ikegami (Patriarch) on Jul 29, 2010 at 15:10 UTC

    Working with the hex representation of the bytes adds complexity, so I started by converting the hex to bytes.

    You didn't specify the type of TAG and LENGTH. I appear to have guessed wrong, or your data is broken.

    use strict; use warnings; my $fh; { my $data = do { local $/; <DATA> }; $data =~ s/\s//g; $data = pack('H*', $data); open($fh, '<', \$data) or die; } my $rv = read($fh, my $hdr, 13); die "$!\n" if !defined($rv); die "Premature EOF\n" if $rv != 13; for (;;) { $rv = read($fh, my $blk_hdr, 2); die "$!\n" if !defined($rv); last if !$rv; die "Premature EOF\n" if $rv != 2; my ($tag, $len) = unpack('CC', $blk_hdr); --$len; printf("tag: 0x%02x\n", $tag); print("len: $len\n"); $rv = read($fh, my $blk_data, $len); die "$!\n" if !defined($rv); die "Premature EOF\n" if $rv != $len; print("data: ", unpack('H*', $blk_data), "\n\n"); } __DATA__ 84 47 00 0c 00 00 11 0a 03 50 35 04 00 64 0a 04 16 12 00 1e 00 1d 00 00 65 09 08 54 52 03 2f 82 05 10 00 02 6e 06 0b a8 53 11 67 00 00 00 7a 7f 00 69 4a 42 47 48 4a 41 0c 00 6a 53 54 4d 44 54 4f 1c 00 66 04 00 00 84 43 00 0c 00 00 11 09 08 43 49 29 60 64 0a 04 16 12 00 21 00 1b 00 00 65 09 08 44 80 90 0f 82 05 10 00 04 6e 06 08 ac 9b 02 67 00 00 00 7a 7f 00 69 53 54 4d 44 54 49 1f 00 6a 4b 43 47 48 51 42 3d 00
    tag: 0x64 len: 9 data: 041612001e001d0000 tag: 0x65 len: 8 data: 085452032f820510 tag: 0x00 len: 1 data: 6e tag: 0x06 len: 10 data: a85311670000007a7f00 tag: 0x69 len: 73 data: 4247484a410c006a53544d44544f1c00660400008443000c0000110908434929 +60640a0416120021001b00006509084480900f82051000046e0608ac9b02670000007 +a7f006953544d tag: 0x44 len: 83 Premature EOF

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://851843]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (3)
As of 2023-02-05 19:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    I prefer not to run the latest version of Perl because:







    Results (32 votes). Check out past polls.

    Notices?