Encoding BCD

[Anonymous Monk]

Monks, thank you so much for the help a while back on decoding my packed (BCD) data file. I thought with the examples, etc. that I could handle the reverse myself, but alas...I am STILL a trainee. I've learned a TON, just not yet the RIGHT ton. So, here's my code- can you explain why my Encode fails? In the .OUT file, it looks like I'm just not going far enough. I'm not quite getting back to the original representation. Thanks again for your patience.

# !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 d
+ata
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;
}