package Palm::LNZReceipt;
use Palm::PDB;

use POSIX qw/mktime strftime/;
use Date::Parse;
use Data::Dumper;

#use Palm::Bitmap;

use constant DEBUG => 0;

use vars qw/ @elems /;

sub import {
    &Palm::PDB::RegisterPDBHandlers(__PACKAGE__,
				    [ "LNZ3", "data" ]
				   );
}

    # Parse $self->{data} and put the fields into new fields in
    # $self.
    my $type = <<END;
   Key as String # This field is mandatory. <sigh>
   ReceiptNo as String
   ReceiptDate as Date
   Amount as Float
   CashOrCheck as Integer
   CheckNo as Integer
   Company as String
   TruckNo as Integer
   TrailerNo as Integer
   LoadNo as Integer
   PurchaseOrderNo as Integer
   ProductName as String
   CaseCount as Integer
   LoadType as Integer
   LoadSize as Integer
   Sig as String
    User as String
    State as String
    Shift as Integer
END

# This regular expression matches any leading whitespace, followed
# by a group of word-chars that are captured, the literal string '
# as ', and a second group of word-chars.  This is interpreted as
# a list of two-element array references, e.g. [ 'ReceiptNo', 'String' ]
@elems = map { /^\s*(\w+) as (\w+)/ && [ $1, $2 ] } split "\n", $type;

#print "There are ", scalar @elems, " elements per record";
DEBUG && print Data::Dumper->Dump( [ \@elems ], [ qw/ *elems / ] );

sub keys { return @{$_[0]->{keys}} }

sub ParseRecord {
    my $self = shift;
    my %record = @_;

    #die Data::Dumper->Dump( [ $self, \%record], [ qw/ self *record / ] );
    $self->{keys} ||= [ map {$_->[0]} @elems[1..$#elems] ];

    #@{self}{qw//} = (unpack $SPEC, $self->{data});


    my $data = $record{data};
    delete $record{data};
    DEBUG and $record{source} = $data; # stash a copy of the unpacked original
    my $index = 0;
    #while (length $data) {
    foreach my $item (@elems) {
	#print "Reading $item->[0] ($item->[1]) at $index\n"; Parse
	# the record.  Each assignment receives its value from a
	# function call matched to the NSBasic type name.  Hence,
	# $item->[1] is 'String', so the fucntion is &String. the
	# parameters are the data stream, the current string index,
	# and the names of the current callbacks for debugging
	# purposes.  The DEBUG items are a list that is included DEBUG
	# times, 0 if DEBUG is off, once if DEBUG is on.
	# push @{$record{keys}}, $item->[0]; # Push the value (column) name into the keys
	$record{data}{$item->[0]} = &{$item->[1]}($data, $index, ($item->[0], $item->[1]) x DEBUG);
	#print "Read $item->[0], a $item->[1]($data, $index) as $record{data}{$item->[0]}\n";
	if (DEBUG && $record{data}{$item->[0]} eq 'Signature') {
	    print ShowSig ($item->[0]);
	}
    }

    # delete $record{data};	# No longer useful
    return \%record;
}

#use Data::Dumper;

# Chew through the bytes in the record, based on the types defined in
# the record declaration above.  Parse and traverse the appropriate
# number of bytes per field of data in the record.

# $_[0] is $data, $_[1] is $index
# we use @_ directly because we can modify it in place.
# in each callback, $_[1] gets incremented by the size of one data item, in bytes.
sub String {
    DEBUG && print Dumper (\@_);

    my $result =
      substr($_[0], $_[1], index ($_[0], "\0", $_[1]+1) - $_[1]);
    $_[1] += length($result) + 1; # increase the index pointer to the
                                  # next item in the record
    $result
}

# Integer is 4 bytes wide.
sub Integer {
    DEBUG && print Dumper (\@_);

    my $result =
    unpack("N", substr($_[0], $_[1], 4));
    $_[1] += 4;			# increase the index pointer
    $result
}

# Float is 8 bytes wide.
sub Float {
    DEBUG && print Dumper (\@_);

    my $result =
    unpack("d", reverse substr($_[0], $_[1], 8));
    $_[1] += 8;			# increase the index pointer
    $result
}

# Date is 8 bytes wide.
# It's a float, with the value representing:
# year * 10000 + month * 100 + day
sub Date {
    DEBUG && print Dumper (\@_);

    my $time = unpack("d", reverse substr($_[0], $_[1], 8));
    my $day = $time % 100;    $time = int ($time / 100);
    my $month = $time % 100;
    my $year = int ($time / 100);
    my $result =
      #mktime(0,0,0,$day, $month - 1, $year);
      strftime("%G-%m-%d", 0,0,0, $day, $month-1, $year);
    $_[1] += 8;			# increase the index pointer
    DEBUG && printf("Found %s", $result);
    $result
}

# $_[0] is $data, $_[1] is $index

# Signature is a string.  Data is currently NOT parsed into full
# value, but stored as-is.
sub Signature {
    DEBUG && print Dumper (\@_);

    my $string = substr($_[0], $_[1], index ($_[0], "\0", $_[1]) - $_[1]);
    $_[1] += length($string) + 1; # increase the index pointer

    my $unpacked;
    my $numchars;
    my ($insertionChar, $special, $pos);

    my ($height, $width, $rowBytes);
    $height = ord(substr($string,5,1));
    $width = ord(substr($string,15,1));
    $rowBytes = ord(substr($string,20,1));
    # print "String is $height x $width, with $rowBytes bytes/row\n";
    return $string;
    #print ShowSig([ $height, $width, $rowBytes, DecodeSig($string) ]);
    # print Display(DecodeSig($string));

    $pos = 20;
    $unpacked = '';
    while ($pos < length($string)) {
	$numchars = ord(substr($string,1));
	$pos++;
	$insertionChar = ord(substr($string,1));
	$pos++;
	$insertionChar = 0 if $insertionChar == 1 and ord(substr($string,1)) == 2;
	for (1..$numchars) {
	    $unpacked .= chr($insertionchar);
	}
    }
    [ $height, $width, $rowBytes, $unpacked ];
}

sub ShowSig {
    my $sig = shift;

    my ($height, $width, $rowBytes, $unpacked) = @$sig;

    my ($index, $line) = (0,0);
    while ($index < length($unpacked)) {
	#print unpack("b*", substr($unpacked + $index, 10));
	for (0..$width) {
	    print ord(substr($unpacked + $index, 1)) == 1 ? '*' : ' ';
	}
	print "\n";
	#unless ($index++ % $rowBytes) {
	#    print "\n";
	#}
	$index += $rowBytes;
    }
}

1;

sub DecodeSig {
    my $src = shift;

    my ($i, $repeat, $ins, $sig);
    $i = 1;

    while ( $i < length( $src ) ) {
	# Determine repeat count
	$repeat = ord( substr($src, $i++) );
	last if $repeat == 0;	# sanity check

	print "repeat is $repeat, ";

	# Determine character to insert
	$ins    = substr( $src, $i++, 1 );

	# Special case x01 characters
	if ( $ins == "\x01" ) {
	    $ins = substr( $src, $i++, 1 );
	    $ins = "\x00" if $ins == "\x02";
	}

	printf "ins is %s\n", ord($ins);

	# Expand insert character
	$sig .= $ins x $repeat;
    }

    return $sig;

}


=pod

- The decoded bitmap will have a 16-byte header as documented by Palm
- Use the dimensions, rowbytes, and bit depth fields.  Ignore the rest.
- There will be only 1 bitmap depth included -- never a bitmap family
- The bit depth field will match the device's current depth: 1, 2, 4, 8, 16bpp
- The bit map will *not* use any form of compression -- making this easier
- No color table is included.  The image data bits start in byte 17
- The image data is in left-to-right, top-down sequence of the pixels
  (Note this differs from a Windows BMP, but I don't know about GIF)
- Each pixel will take the next 1, 2, 4, 8, or 16 bits.  But at the end of
  a device row there may be bits added for padding to make each
  row take exactly the number of bytes identified in the Palm OS header

=cut


sub Display {
    my $data = shift;

    # unpack and display the header structure
    # PalmOS 1 and 2 show the header as:
    # typedef struct {
    # Word compressed:1; 0=raw; 1=compressed
    # Word reserved :15;
    # } BitmapFlagsType;
    # typedef struct {
    # Word width;
    # Word height;
    # Word rowBytes;
    # BitmapFlagsType flags;
    # Word reserved [4];
    # } BitmapType;

    ($wid, $hgt, $bwidth, $flags) = unpack('nnnn', $data);
    print "width = $wid height = $hgt";
    print "bwidth = $bwidth flags = ";
    printf("%04X", $flags);
    if (($flags & 0x8000) != 0) {
	print " (compressed)";
    }
    print "\n";

    # distinguish between compressed and uncompressed bitmaps

    if (($flags & 0x8000) == 0) {
	print "*uncompressed bitmap*\n";
	# display an uncompressed bitmap
	$pixels = substr($data, 16);
	for $y (0..$hgt-1) {
	    $row = unpack('B*', substr($pixels, $bwidth * $y, $bwidth));
	    $row =~ tr/01/.x/;
	    print substr($row, 0, $wid) . "\n";
	}

    } else {

	# display a compressed bitmap. remove the header

	$compressedBytes = substr($data, 16);
	$again = 1;
	$offset = 0;
	$qtyBytes = unpack('S', substr($compressedBytes,$offset, 2));
	$offset = 2;
	$lastScanline = "";
	for $y (0..$hgt-1) {

	    # start a new scan line

	    $scanline = "";
	    do {

		#get the flags byte

		$flags = substr($compressedBytes, $offset++, 1);
		$changes = unpack('B*', $flags);
		for $bit (0..7) {
		    $byteFlag = substr($changes, $bit, 1);
		    if ($byteFlag) {
			$nextByte = substr($compressedBytes, $offset++, 1);
			$b = unpack('C', $nextByte);
			$scanline .= unpack('B*', $nextByte);
		    } else {
			$nextByte = substr($lastScanline, length($scanline), 8);
			$scanline .= $nextByte;
		    }
		}

	    } until (length($scanline) >= $wid);

	    # now display the scan line. display the bits
	    $row = $scanline;
	    $row =~ tr/01/.x/;
	    print substr($row, 0, $wid) . "\n";

	    #remember this scan line for the next row
	    $lastScanline = $scanline;

	}
    }
}

1;

__END__



http://groups.yahoo.com/group/nsbasic-palm/message/16198

Function Unpack(NSBString as String) as String
    Dim Unpacked as String
    Dim NumOfCharacters as Integer
    Dim InsertionCharacter as Integer
    Dim SpecialCharacter as Integer
    Dim StringPosition as Integer
    Dim i as Integer
    StringPosition=1
    Unpacked=""                     'null string'
    Do while StringPosition < Len(NSBString)
        NumOfCharacters = ASC(MID(NSBString,StringPosition,1))
        StringPosition = StringPosition+1
        InsertionCharacter = ASC(MID(NSBString,StringPosition,1))
        StringPosition = StringPosition+1
        If InsertionCharacter=1 Then
            SpecialCharacter = ASC(MID(NSBString,StringPosition,1))
            StringPosition = StringPosition+1
            If SpecialCharacter = 2 Then
                InsertionCharacter = 0
            End If
        End If
        For i = 1 to NumOfCharacters
            Unpacked = Unpacked + chr(InsertionCharacter)
        Next
    Loop
    Unpack = Unpacked
End Function


# Host:
# Database: receipts
# Table: 'orders'
#
CREATE TABLE `orders` (
  `receiptno` varchar(9) NOT NULL default '',
  `receiptdate` date default NULL,
  `amount` decimal(9,2) default NULL,
  `cashorcheck` int(11) default NULL,
  `checkno` int(11) default NULL,
  `company` varchar(100) default NULL,
  `truckno` varchar(100) default NULL,
  `trailerno` varchar(100) default NULL,
  `loadno` varchar(15) default NULL,
  `purchaseorderno` varchar(16) default NULL,
  `productname` varchar(100) default NULL,
  `casecount` int(11) default NULL,
  `loadtype` int(11) default NULL,
  `loadsize` int(11) default NULL,
  `sig` text default NULL,
  `user` text,
  `state` text,
  `shift` int(2),
  PRIMARY KEY  (`receiptno`)
) TYPE=MyISAM;