--- 3m-810.pl	2008/09/28 12:57:32	1
+++ 3m-810.pl	2008/09/28 14:05:43	2
@@ -5,6 +5,7 @@
 use warnings;
 
 use Data::Dump qw/dump/;
+use Carp qw/confess/;
 
 my $response = {
 	'd500090400110a0500027250'				=> 'version?',
@@ -74,21 +75,12 @@
 #$port->stty_inpck(1);
 #$port->stty_istrip(1);
 
-sub cmd {
-	my ( $cmd, $desc, $expect ) = @_;
-	$cmd =~ s/\s+(\S\S)(\S\S)+\s*/ $1 $2/;	# fix checksum
-	$cmd =~ s/\s+/\\x/g;
-	$cmd = '"\x' . $cmd . '"';
-	my $bytes = eval $cmd;
-	die $@ if $@;
-	warn ">> ", as_hex( $bytes ), "\t$desc\n";
-	writechunk( $bytes );
-	warn "?? $expect\n" if $expect;
-	readchunk();
-}
-
 cmd( 'D5 00  05  04   00   11                 8C66', 'hw version?',
-     'D5 00  09  04   00   11   0A 05 00 02   7250 -- hw 10.5.0.2' );
+     'D5 00  09  04   00   11   0A 05 00 02   7250', 'hw 10.5.0.2', sub {
+	my ( $len, $payload, $checksum ) = @_;
+	assert( 0, 3 );
+	print "hardware version ", join('.', unpack('CCCC', substr($payload,3,4))), "\n";
+});
 
 cmd( 'D6 00  0C  13   04   01 00  02 00  03 00  04 00   AAF2','stats?' );
 #     D6 00  0C  13   00   02 01 01 03 02 02 03  00   E778
@@ -140,7 +132,6 @@
 sub writechunk
 {
 	my $str=shift;
-
 	my $count = $port->write($str);
 	print ">> ", as_hex( $str ), "\t[$count]\n";
 }
@@ -149,7 +140,7 @@
 	my @out;
 	foreach my $str ( @_ ) {
 		my $hex = unpack( 'H*', $str );
-		$hex =~ s/(..)/$1 /g;
+		$hex =~ s/(..)/$1 /g if length( $str ) > 2;
 		push @out, $hex;
 	}
 	return join('  ', @out);
@@ -168,15 +159,69 @@
 	return $data;
 }
 
+my $assert;
+
+sub assert {
+	my ( $from, $to ) = @_;
+
+	warn "# assert ", dump( $assert );
+
+	my $p = substr( $assert->{payload}, $from, $to );
+	my $e = substr( $assert->{expect},  $from, $to );
+	warn "EXPECTED ",as_hex($e), " GOT ", as_hex($p), "\t[$from-$to]\n" if $e ne $p;
+}
+
 sub readchunk {
+	my ( $parser ) = @_;
+
+	sleep 1;	# FIXME remove
 
 	# read header of packet
 	my $header = read_bytes( 2, 'header' );
-	my $len = ord( read_bytes( 1, 'length' ) );
+	my $length = read_bytes( 1, 'length' );
+	my $len = ord($length);
 	my $data = read_bytes( $len, 'data' );
+	my ( $cmd ) = unpack('C', $data );
+
+	my $payload  = substr( $data, 0, -2 );
+	my $payload_len = length($data);
+	warn "## payload too short $payload_len != $len\n" if $payload_len != $len;
+	my $checksum = substr( $data, -2, 2 );
+	# FIXME check checksum
 
-	warn "<< ",as_hex( $header, ), " [$len] ", as_hex( $data ), "\n";
+	print "<< ",as_hex( $header ), " [$len] ", as_hex( $payload ), "checksum: ", as_hex( $checksum ),"\n";
 
-	sleep 1;
+	$assert->{len}      = $len;
+	$assert->{payload}  = $payload;
+	$assert->{checksum} = $checksum;
+
+	$parser->( $len, $payload, $checksum ) if $parser && ref($parser) eq 'CODE';
+
+	return $data;
+}
+
+sub str2bytes {
+	my $str = shift || confess "no str?";
+	$str =~ s/\s+(\S\S)(\S\S)+\s*/ $1 $2/;	# fix checksum
+	$str =~ s/\s+/\\x/g;
+	$str = '"\x' . $str . '"';
+	my $bytes = eval $str;
+	die $@ if $@;
+	return $bytes;
+}
+
+sub cmd {
+	my ( $cmd, $cmd_desc, $expect, $expect_desc, $coderef ) = @_;
+	my $bytes = str2bytes( $cmd );
+
+	warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n";
+	$assert->{send} = $cmd;
+	writechunk( $bytes );
+
+	if ( $expect ) {
+		warn "?? $expect", $expect_desc ? "\t## $expect_desc" : '', "\n";
+		$assert->{expect} = substr(str2bytes($expect), 3, -2); # just expected payload
+		readchunk( $coderef );
+	}
 }