# !perl      Test_BCD.pl
# The first 6 bytes of my test file contain the 12 digit BCD 
# (Binary Coded Decimal) UPC Barcode 123456781020.  This needs 
# to be broken down into 3 testable/printable fileds and printed 
# as 12-34567-81020. Then re-assembled back into the 2 digits per 
# byte BCD format. I'm trying to use the Decode_BCD & Encode_BCD 
# subroutines below to do this.

open (inFILE, "<C:/Dev/Perl_Dev/ItemExp/TESTFILE.DAT") || 
                    die "Cannot open file\n";

# First 6 bytes are "\x12\x34\x56\x78\x10\x20"
binmode (inFILE);
open (outFILE, ">C:/Dev/Perl_Dev/ItemExp/TESTFILE.OUT") || 
                    die "Cannot open file\n";
binmode (outFILE);
seek (inFILE,0,0);
read (inFILE,$inBuf,6);

$test1 = Decode_BCD($inBuf);
$first2 = substr($test1,0,2);
$MfgID = substr($test1,2,5);
$Item = substr($test1,7.5);
$test2 = Encode_BCD(join('',$first,$MfgID,$Item));
                   
if ($test1 = $test2) {
   $comp = "EQUALS";
}  else  {
   $comp = "Does NOT Equal";
}

print "\n\n ..and the results are.... drum roll....";
print "\n\tFirst 2 chars = $first2";
print "\n\tManufactur ID = $MfgID";    # these print correctly
print "\n\tItem Code     = $Item";

print "\n\n test1 $comp test2";   # This prints that they're EQUAL.
print "\n";

seek (outFILE,0,0);
print outFILE "$inBuf"; # In the output file, this shows the correct data
seek (outFILE,16,0);
print outFILE "$test1"; # This is strange-ness CE 0A 47 46 00 00
seek (outFILE,32,0);
print outFILE "$test2"; # This is the same strange-ness CE 0A 47 46 00 00

close inFILE;
close outFILE;

sub Decode_BCD
{
   my $str = shift;
   my $hex;
   $hex .= sprintf "%02x", ord
       for split //, $str;
   return $hex;
}

sub Encode_BCD
{
   my $str = shift;
   my $hex;

   $hex .= pack("N", $str), 
       for substr($str,0,2);

   return $hex;
}