--- 3m-810.pl 2008/10/03 21:47:24 21 +++ 3m-810.pl 2009/03/28 03:47:10 23 @@ -8,6 +8,16 @@ use Carp qw/confess/; use Getopt::Long; +use IO::Socket::INET; + +my $meteor = IO::Socket::INET->new( '192.168.1.13:4671' ) || die "can't connect to meteor: $!"; + +sub meteor { + my ( $item, $html ) = @_; + warn ">> meteor $item $html\n"; + print $meteor "ADDMESSAGE test $item|" . localtime() . "
$html\n"; +} + my $debug = 0; my $device = "/dev/ttyUSB0"; @@ -30,7 +40,7 @@ }; GetOptions( - 'd|debug+' => \$debug, + 'd|debug+' => \$debug, 'device=s' => \$device, 'baudrate=i' => \$baudrate, 'databits=i' => \$databits, @@ -39,6 +49,8 @@ 'handshake=s' => \$handshake, ) or die $!; +my $verbose = $debug > 0 ? $debug-- : 0; + =head1 NAME 3m-810 - support for 3M 810 RFID reader @@ -81,7 +93,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(); @@ -96,7 +108,9 @@ cmd( 'D5 00 05 04 00 11 8C66', 'hw version', 'D5 00 09 04 00 11 0A 05 00 02 7250', sub { - print "hardware version ", join('.', unpack('CCCC', skip_assert(3) )), "\n"; + my $hw_ver = join('.', unpack('CCCC', skip_assert(3) )); + print "hardware version $hw_ver\n"; + meteor( -1, "Found reader $hw_ver" ); }); cmd( 'D6 00 0C 13 04 01 00 02 00 03 00 04 00 AAF2','FIXME: stats?', @@ -105,17 +119,14 @@ # 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(); + meteor( -1, "No tags in range" ); } else { my $tags = substr( $rest, 1 ); @@ -126,26 +137,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"; + print "$nr tags in range: ", join(',', @tags ) , "\n"; + + update_visible_tags( @tags ); + + my $html = join('', map { "
  • $_" } @tags); + meteor( 0, "Tags:" ); + } + } +) foreach ( 1 .. 1000 ); - my $removed_tags = $visible_tags; - $visible_tags = {}; - foreach my $tag ( @tags ) { - next if $visible_tags->{$tag}++; - read_tag( $tag ); - if ( delete $removed_tags->{$tag} ) { - print "removed tag $tag\n"; - } - } +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 ( 1 .. 100 ); + + foreach my $tag ( keys %$last_visible_tags ) { + my $data = delete $tags_data->{$tag}; + print "removed tag $tag with data ",dump( $data ),"\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( @@ -185,6 +220,9 @@ } warn "?? D6 00 0F FE 00 00 05 01 $tag 941A ##### ready?\n"; + my $item = unpack('H*', substr($tag,-8) ) % 100000; + meteor( $item, "Loading $item" ); + } exit; @@ -320,7 +358,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 +404,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 );