--- 3m-810.pl	2008/09/28 15:59:38	4
+++ 3m-810.pl	2008/09/28 18:13:21	5
@@ -81,19 +81,34 @@
 
 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', sub {
-	my ( $len, $payload, $checksum ) = @_;
-	assert( 0, 3 );
-	print "hardware version ", join('.', unpack('CCCC', substr($payload,3,4))), "\n";
+	print "hardware version ", join('.', unpack('CCCC', skip_assert(3) )), "\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','FIXME: unimplemented', sub { assert( 0 ) } );
+     'D6 00  0C   13  00  02 01 01 03 02 02 03  00     E778','FIXME: unimplemented', sub { assert() }  );
 
 # start scanning for tags
 
-cmd( 'D6 00  05  FE     00  05      FA40', "XXX scan $_",
-     'D6 00  07  FE  00 00  05  00  C97B', 'no tag' ) foreach ( 1 .. 10 );
-#     D6 00  0F  FE  00 00  05  01  E00401003123AA26  941A	 # seen
+cmd( 'D6 00  05   FE     00  05         FA40', "XXX scan $_",
+     'D6 00  07   FE  00 00  05     00  C97B', 'no tag', sub {
+dispatch( 
+	 'D6 00  0F   FE  00 00  05 ',# 01 E00401003123AA26  941A	 # seen, serial length: 8
+	 	sub {
+			my $rest = shift || die "no rest?";
+			my $nr = ord( substr( $rest, 0, 1 ) );
+			my $tags = substr( $rest, 1 );
+
+			my $tl = length( $tags );
+			die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
+
+			my @tags;
+			push @tags, substr($tags, $_ * 8, 8) foreach ( 0 .. $nr - 1 );
+			warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags );
+			print "seen $nr tags: ", join(',', map { unpack('H16', $_) } @tags ) , "\n";
+		}
+) }
+
+) foreach ( 1 .. 100 );
 
 cmd( 'D6 00  0D  02      E00401003123AA26   00   03     1CC4', 'read offset: 0 blocks: 3' );
 
@@ -164,16 +179,43 @@
 	return $data;
 }
 
-my $assert;
+our $assert;
+
+# my $rest = skip_assert( 3 );
+sub skip_assert {
+	assert( 0, shift );
+}
 
 sub assert {
 	my ( $from, $to ) = @_;
 
+	$from ||= 0;
 	$to = length( $assert->{expect} ) if ! defined $to;
 
 	my $p = substr( $assert->{payload}, $from, $to );
 	my $e = substr( $assert->{expect},  $from, $to );
 	warn "EXPECTED ",as_hex($e), " GOT ", as_hex($p), " [$from-$to] in ",dump( $assert ), "\n" if $e ne $p;
+
+	# return the rest
+	return substr( $assert->{payload}, $to );
+}
+
+our $dispatch;
+sub dispatch {
+	my ( $pattern, $coderef ) = @_;
+	my $patt = substr( str2bytes($pattern), 3 ); # just payload
+	my $l = length($patt);
+	my $p = substr( $assert->{payload}, 0, $l );
+	warn "## dispatch pattern $pattern [$l] ",dump( $patt, $p );
+
+	if ( $assert->{payload} eq $assert->{expect} ) {
+		warn "## no dispatch, payload expected\n";
+	} elsif ( $p eq $patt ) {
+		# if matched call with rest of payload
+		$coderef->( substr( $assert->{payload}, $l ) );
+	} else {
+		warn "## dispatch ignored\n";
+	}
 }
 
 sub readchunk {
@@ -207,11 +249,14 @@
 
 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;
+	my $b = $str;
+	$b =~ s/\s+(\S\S)(\S\S)+\s*/ $1 $2/;	# fix checksum
+	$b =~ s/\s+$//;
+	$b =~ s/\s+/\\x/g;
+	$b = '"\x' . $b . '"';
+	my $bytes = eval $b;
 	die $@ if $@;
+	warn "## str2bytes( $str ) => $b => ",as_hex($bytes) if $debug;
 	return $bytes;
 }