Help me on reading binary file

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

hi

This is my code to read siemens binary file with variable len record. But the output look incorrect and its look my program it was looping wrongly / twice. Could somebody help me where is the error ?.

#!/usr/bin/perl -w

use Cwd;
use warnings;
use strict;
use Getopt::Long;
use Switch;
use POSIX qw(ceil floor);

use constant FILEHDR => 4;
use constant CDRLEN  => 286;

my ($trace, $help, $infile, $decode, $len, $template, $name, $director
+y_num, $i);
my $swap = '';
my $indir  = getcwd;
my $outdir = getcwd;

my $num = 1;
my @rec;
my @record;
my @tmp;
my @header;

GetOptions (
    "h|help"    => \$help,
    "filename|f=s"    => \$infile,
    "swap|s"    => \$swap,
    "decode|d"    => \$decode,
    "input|i=s"    => \$indir,
    "output|o=s"    => \$outdir,
    "trace|t"    => \$trace
) or usage();


sub usage {
    exit;
}

my @tt         = ("Flags", "Record Seq.", "Charge Status");
my @datelst = ("Year","Month","Day","Hour","Minute","Second", "Reserve
+d","Duration");

my $outfile = $infile;
my $data;

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 ($length,$tag, $raw, $test);
sub display {
    print "~~~~~~~~~~~~~~~~~~~~~~~~ RECORD $num ~~~~~~~~~~~~~~~~~~~~~~
+~~~~~~~~\n" if ($trace);

    read (DATA, $data, 1);
    $tag = unpack "H2", substr $data,0,1,'';
    $raw = $tag;

    if ($tag =~ /(81|80|00)/) {
        # the Record Identifier H’80 is used as Filler record to fill 
+in one byte
        if ($tag == "80") {
            $length = 2;
        }

        # the Record Identifier H’81 is used as Filler record to fill 
+in several bytes
        if ($tag == "81") {
            read (DATA, $data, 2);
            $length = unpack "v4", $data; #substr $data,0,2,'';
            $length = $length - 3;
            read (DATA, $data, $length);
        }

        # the Record Identifier H’00 is used as Filler record to fill 
+in 32 bytes
        if ($tag == "00") {
            $length=62;
            read (DATA, $data, $length);
        }

        $raw = unpack "H*", $data;

        if ($trace) {
            print  ("FILLER\n");
            printf ("%-20s : %-5s\n", "TAG", $tag);
            printf ("%-20s : %-5s\n", "RECORD LENGTH", $length);
            print  ("RAW DATA : \n$raw\n");
        }

    } else {
        read (DATA, $data, 2);
        $length = unpack "v4", $data; #substr $data,0,2,'';

        read (DATA, $data, $length-3);

        $raw = $raw . inttohex($length);
        $raw = $raw . unpack "H*", $data;
    
        # Read Fixed Record Header
        @header = unpack "H6 H2 H2", substr $data,0,5,'';
        $test = $header[2];
    
        if ($test ne "") {

            #print "TEST: $tag - $length - $#header - $test - @header\
+n";
            $len = floor(hextoint(substr($header[2],1,1))/2 + 0.5);
    
            if ($trace) {
                printf ("%-20s : %-5s >%s<\n", "TAG" , hextoint($tag),
+ $tag);
                printf ("%-20s : %-5s >%s<\n", "RECORD LENGTH", $lengt
+h, inttohex($length));
                printf ("\nHEADER\n");
                for (my $i=0; $i<@header; $i++) {
                    printf (" |- %-16s : %s\n", $tt[$i],$header[$i]);
                }
            }
    
            $template = "H" . $len*2;
            $directory_num = unpack $template, substr $data,0,$len,'';
        
            if ($trace) {
                printf (" |- %-16s : %s\n", "Directory Number", $direc
+tory_num);
                printf ("\nDATA PACKAGE\n");
            } else {
                printf ("%s,%s,%s,", hextoint($tag),$length+2,$directo
+ry_num);
            }

            # Read Variable Data based on variable record length
            while ($data) {
                $tag = unpack "H2", substr $data,0,1,'';
    
                switch (uc($tag)) {
                    # Package 100
                    # fixed 11 bytes
                        case "64" { $len = 10;     
                            $template = 'C20';
                            $name = "DateTime/Duration" }
    
                    # Package 101
                        case "65" { $len = unpack "C",  substr $data,0
+,1,''; 
                            $len = floor($len/2 + 0.5);
                            $template = 'H' . $len*2;
                            $name = "Partner No" }
    
                    # Package 102
                    # fixed 4 bytes
                        case "66" { $len = 3;
                            $template = 'C6';
                            $name = "Service Info" }
    
                    # Package 103
                    # fixed 4 bytes
                        case "67" { $len = 3;
                            $template = 'C6';
                            $name = "Charge Unit" }
    
                    # Package 104
                    # fixed 3 bytes
                        case "68" { $len = 2;
                            $template = 'C6';
                            $name = "Charge Unit FAU" }
    
                    # Package 105
                    # fixed 9 bytes
                        case "69" { $len = 8;
                            $template = 'A6 C2';
                            $name = "Trunk ID Incoming" }
    
                    # Package 106
                    # fixed 9 bytes
                        case "6A" { $len = 8;
                            $template = 'A6 C2';
                            $name = "Trunk ID Outgoing" }
    
                    # Package 107
                    # fixed 10 bytes
                        case "6B" { $len = 9;
                            $template = 'A6 C3';
                            $name = "Trunk ID Incoming - CIC" }
    
                    # Package 108
                    # fixed 10 bytes
                        case "6C" { $len = 9;
                            $template = 'A6 C3';
                            $name = "Trunk ID Outgoing - CIC" }
    
                    # Package 110
                    # fixed 6 bytes - including TAG and Length
                        case "6E" { $len = 4;
                            $template = 'C8';
                            $name = "Connection ID" }    
    
                    # Package 111                    
                    # variable length stored on byte 2 of the package
                    case "6F" { $len = unpack "C",  substr $data,0,1,'
+';  
                            $len = $len - 2;
                             $template = 'C' . $len*2;
                            $name = "Facility Used by Owner" }
    
                    # Package 112
                    # variable length stored on byte 2 of the package
                    case "70" { $len = unpack "C",  substr $data,0,1,'
+'; 
                            $len = $len - 2;
                             $template = 'C' . $len*2;
                            $name = "Facility Used by Partner" }
    
                    # Package 113
                    # fixed 4 bytes - including TAG and Length    
                        case "71" { $len = 2;
                            $template = 'C' . $len;
                            $name = "Facility Input" }
    
                    # Package 116
                    # fixed 8 bytes    
                        case "74" { $len = 7;
                            $template = 'C14';
                            $name = "DateTime" }    
    
                    # Package 117
                    case "75" { $len = unpack "C",  substr $data,0,1,'
+';
                            $len = $len - 2;
                             $template = 'H' . $len*2;
                            $name = "Project Specific Data" }
    
                    # Package 118 
                        case "76" { $len = unpack "C",  substr $data,0
+,1,''; 
                            $len = floor($len/2 + 0.5);
                            $template = 'H' . $len*2;
                            $name = "Digit String" }
    
                    # Package 120
                    # fixed 2 bytes
                        case "78" { $len = 1;
                            $template = 'C2';
                            $name = "Category" }
    
                    # Package 122
                    # fixed 3 bytes
                        case "7A" { $len = 2;
                            $template = 'C4';
                            $name = "Zone" }
    
                    # Package 125
                    case "7D" { $len = unpack "C",  substr $data,0,1,'
+'; 
                            $len = $len - 2;
                            $template = 'H' . $len*2;
                            $name = "Account Code" }
    
                    # Package 130
                    # fixed 5 bytes - including TAG and Length
                        case "82" { $len = unpack "C", substr $data,0,
+1,'';
                            $len = $len - 2;
                            $template = 'H' . $len*2;
                            $name = "Traffic Quality Data" }
    
                    # Package 132
                    #case "84" { $len = unpack "C", substr $data,0,1,'
+';     
                    #$len = $len - 2;
                    #$template = 'C8';
                    #$name = "Header" }
    
                    # Package 134
                    # fixed 6 bytes - including TAG and Length    
                        case "86" { $len = 4;
                            $template = 'C8';
                            $name = "Duration Before Answer" }
    
                    # Package 135
                    # fixed 5 bytes - including TAG and Length    
                        case "87" { $len = 3;
                            $template = 'C6';
                            $name = "ChargeBand" }
    
                    # Package 136
                    # fixed 6 bytes - including TAG and Length    
                        case "88" { $len = 4;
                            $template = 'C8';
                            $name = "UUS3 Counters" }
    
                    # Package 142
                        case "8E" { $len = unpack "C", substr $data,0,
+1,'';
                            $len = $len - 2;
                            $template = 'H' . $len*2;
                            $name = "DDI Number" }
    
                    # Package 143
                    case "8F" { $len = unpack "C", substr $data,0,1,''
+;
                            $len = $len - 2;
                             $template = 'H' . $len*2;
                            $name = "IP/SN Charge Data" }
                        
                    # Package 145
                    case "91" { $len = unpack "C",  substr $data,0,1,'
+';
                            $len = $len - 2;
                             $template = 'H' . $len;
                            $name = "CAC Number" }
    
                    # Package 146
                    case "92" { $len = unpack "C",  substr $data,0,1,'
+';
                            $len = $len - 2;
                             $template = 'H' . $len;
                            $name = "Third Party Number" }
    
                    # Package 157
                    case "9D" { $len = unpack "C", substr $data,0,1,''
+;
                            $len = $len - 2;
                             $template = 'H' . $len*2;
                            $name = "Outgoing PA Slave ID" }
                }
                @record = unpack $template, substr $data,0,$len,'';
    
                my $rec = join('', @record);
    
                if ($trace) {
                    printf "- %s\n", $name;
                    printf "  |- %-16s : %-5s >%s<\n","TAG",hextoint($
+tag),uc($tag);
                    printf "  |- %-16s : %-5s \n","LENGTH",$len;
                    printf "  |- %-16s : %s\n\n","DATA",uc($rec);
    
                } elsif ($decode) {
                    printf "%s,",uc($rec);
                }
            }
            print "\n" if $decode;
        }
        $num++;
        printf "RAW DATA: \n$raw\n\n" if ($trace);
    }
}

if ($infile) {
    open (OUTPUT, ">$outdir/$outfile") if (!$trace);
    open (DATA, "$indir/$infile");
    binmode DATA;
    

    until (eof DATA) {
        display() if ($trace || $decode);
    }

    close(DATA);
    close(OUTPUT) if (!$trace);
}
[download]

Comment on Help me on reading binary file Download Code

Replies are listed 'Best First'.
Re: Help me on reading binary file by roboticus (Chancellor) on Nov 29, 2010 at 05:31 UTC
Hmmm ... no pointer to the filespec, no sample input data, no description of the desired output, nor any of the erroneous output. You're really asking someone to do a lot of work just to figure out what's wrong. Thanks, but I'll pass. Try reading Ask questions the smart way, I know what I mean. Why don't you? and How (Not) To Ask A Question and update your node... ...roboticus	[reply]
Re: Help me on reading binary file by cdarke (Prior) on Nov 29, 2010 at 07:53 UTC
its look my program it was looping wrongly / twice Which loop? There is a huge loop within the `display` subroutine, and one in the main program. If the one in the subroutine is wrong, then look at where you change `$data`: `@record = unpack $template, substr $data,0,$len,'';` [download] Maybe check `$len`? If the loop in main, then that would indicate you are not hitting end-of-file when you expect, which implies the file has a different layout to the one you expect. Go back to the specification of the file layout and recheck your code. Update: I just noticed you are using Switch. This has a range of strange side effects, and should not be used - use given/when, or a hased based despatch table instead. I can't say that Switch would cause your problems, but those are rather vague anyhow.	[reply] [d/l] [select]