--- 3m-810.pl 2008/10/03 21:47:24 21 +++ 3m-810.pl 2008/10/04 11:55:30 22 @@ -30,7 +30,7 @@ }; GetOptions( - 'd|debug+' => \$debug, + 'd|debug+' => \$debug, 'device=s' => \$device, 'baudrate=i' => \$baudrate, 'databits=i' => \$databits, @@ -39,6 +39,8 @@ 'handshake=s' => \$handshake, ) or die $!; +my $verbose = $debug > 0 ? $debug-- : 0; + =head1 NAME 3m-810 - support for 3M 810 RFID reader @@ -70,9 +72,6 @@ =cut -my $tags_data; -my $visible_tags; - my $port=new Device::SerialPort($device) || die "can't open serial port $device: $!\n"; warn "using $device $handshake $baudrate $databits $parity $stopbits" if $debug; $handshake=$port->handshake($handshake); @@ -81,7 +80,7 @@ $parity=$port->parity($parity); $stopbits=$port->stopbits($stopbits); -print "## using $device $baudrate $databits $parity $stopbits\n"; +print "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n"; # Just in case: reset our timing and buffers $port->lookclear(); @@ -105,17 +104,13 @@ # start scanning for tags cmd( 'D6 00 05 FE 00 05 FA40', "scan for tags, retry $_", - 'D6 00 07 FE 00 00 05 00 C97B', sub { - assert(); - print "no tag in range\n"; - - }, 'D6 00 0F FE 00 00 05 ', sub { # 01 E00401003123AA26 941A # seen, serial length: 8 my $rest = shift || die "no rest?"; my $nr = ord( substr( $rest, 0, 1 ) ); if ( ! $nr ) { print "no tags in range\n"; + update_visible_tags(); } else { my $tags = substr( $rest, 1 ); @@ -126,26 +121,50 @@ my @tags; push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 ); warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug; - print "seen $nr tags: ", join(',', @tags ) , "\n"; - - my $removed_tags = $visible_tags; - $visible_tags = {}; + print "$nr tags in range: ", join(',', @tags ) , "\n"; - foreach my $tag ( @tags ) { - next if $visible_tags->{$tag}++; - read_tag( $tag ); - if ( delete $removed_tags->{$tag} ) { - print "removed tag $tag\n"; - } - } + update_visible_tags( @tags ); } } ) foreach ( 1 .. 100 ); + + +my $tags_data; +my $visible_tags; + +sub update_visible_tags { + my @tags = @_; + + my $last_visible_tags = $visible_tags; + $visible_tags = {}; + + foreach my $tag ( @tags ) { + if ( ! defined $last_visible_tags->{$tag} ) { + read_tag( $tag ); + $visible_tags->{$tag}++; + } else { + warn "## using cached data for $tag" if $debug; + } + delete $last_visible_tags->{$tag}; # leave just missing tags + } + + foreach my $tag ( keys %$last_visible_tags ) { + print "removed tag $tag with data ",dump( delete $tags_data->{$tag} ),"\n"; + } + + warn "## update_visible_tags(",dump( @tags ),") = ",dump( $visible_tags )," removed: ",dump( $last_visible_tags ), " data: ",dump( $tags_data ) if $debug; +} + + sub read_tag { my ( $tag ) = @_; + confess "no tag?" unless $tag; + + return if defined $tags_data->{$tag}; + print "read_tag $tag\n"; cmd( @@ -320,7 +339,7 @@ my $checksum = substr( $data, -2, 2 ); checksum( $header . $length . $payload , $checksum ); - print "<< ",as_hex( $header ), " [$len] ", as_hex( $payload ), " | sum: ",as_hex($checksum),"\n"; + print "<< ",as_hex( $header ), " [$len] ", as_hex( $payload ), " | sum: ",as_hex($checksum),"\n" if $verbose; $assert->{len} = $len; $assert->{payload} = $payload; @@ -366,7 +385,7 @@ # fix checksum if needed $bytes = checksum( substr( $bytes, 0, -2 ), substr( $bytes, -2, 2 ) ); - warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n"; + warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n" if $verbose; $assert->{send} = $cmd; writechunk( $bytes );