1 package RFID::Serial::3M810;
3 use base 'RFID::Serial';
6 use Data::Dump qw(dump);
11 sub serial_settings {{
12 device => "/dev/ttyUSB1", # FIXME comment out before shipping
26 my ( $count, $str ) = $port->read(3);
27 my $data = $port->read( ord(substr($str,2,1)) );
28 warn "drain ",as_hex( $str, $data ),"\n";
36 my $crc = Digest::CRC->new(
37 # midified CCITT to xor with 0xffff instead of 0x0000
38 width => 16, init => 0xffff, xorout => 0xffff, refout => 0, poly => 0x1021, refin => 0,
41 pack('n', $crc->digest);
45 Time::HiRes::sleep 0.015;
49 my ( $hex, $description, $coderef ) = @_;
50 my $bytes = hex2bytes($hex);
51 if ( substr($bytes,0,1) !~ /(\xD5|\xD6)/ ) {
52 my $len = pack( 'n', length( $bytes ) + 2 );
53 $bytes = $len . $bytes;
54 my $checksum = checksum($bytes);
55 $bytes = "\xD6" . $bytes . $checksum;
58 warn ">> ", as_hex( $bytes ), "\t\t[$description]\n";
59 $port->write( $bytes );
63 my $r_len = $port->read(3);
67 $r_len = $port->read(3);
72 my $len = ord( substr($r_len,2,1) );
73 $data = $port->read( $len );
74 warn "<< ", as_hex($r_len,$data)," $len\n";
76 $coderef->( $data ) if $coderef;
81 my ( $got, $expected ) = @_;
82 $expected = hex2bytes($expected);
84 my $len = length($got);
85 $len = length($expected) if length $expected < $len;
87 confess "got ", as_hex($got), " expected ", as_hex($expected)
88 unless substr($got,0,$len) eq substr($expected,0,$len);
90 return substr($got,$len);
96 'D5 00 05 04 00 11 8C66', 'hw version', sub {
98 my $rest = assert $data => '04 00 11';
99 my $hw_ver = join('.', unpack('CCCC', $rest));
100 warn "# 3M 810 hardware version $hw_ver\n";
104 '13 04 01 00 02 00 03 00 04 00','FIXME: stats? rf-on?', sub { assert(shift,
105 '13 00 02 01 01 03 02 02 03 00'
111 my @tags = inventory;
119 cmd( 'FE 00 05', 'scan for tags', sub {
121 my $rest = assert $data => 'FE 00 00 05';
122 my $nr = ord( substr( $rest, 0, 1 ) );
125 warn "# no tags in range\n";
127 my $tags = substr( $rest, 1 );
128 my $tl = length( $tags );
129 die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
131 foreach ( 0 .. $nr - 1 ) {
132 push @tags, hex_tag substr($tags, $_ * 8, 8);
138 warn "# tags ",dump @tags;
144 # cards 16, stickers: 8
145 my $max_rfid_block = 8;
149 my ( $data, $hex ) = @_;
150 my $b = hex2bytes $hex;
152 if ( substr($data,0,$l) eq $b ) {
153 warn "_matched $hex [$l] in ",as_hex($data);
154 return substr($data,$l);
159 my $tag = shift || confess "no tag?";
160 $tag = shift if ref($tag);
165 sprintf( "02 $tag %02x %02x", $start, $blocks ) => "read_blocks $tag $start/$blocks", sub {
167 if ( my $rest = _matched $data => '02 00' ) {
169 my $tag = hex_tag substr($rest,0,8);
170 my $blocks = ord(substr($rest,8,1));
171 warn "# response from $tag $blocks blocks ",as_hex substr($rest,9);
172 foreach ( 1 .. $blocks ) {
173 my $pos = ( $_ - 1 ) * 6 + 9;
174 my $nr = unpack('v', substr($rest,$pos,2));
175 my $payload = substr($rest,$pos+2,4);
176 warn "## pos $pos block $nr ",as_hex($payload), $/;
177 $tag_blocks->{$tag}->[$nr] = $payload;
179 } elsif ( my $rest = _matched $data => 'FE 00 00 05 01' ) {
180 warn "FIXME ready? ",as_hex $test;
181 } elsif ( my $rest = _matched $data => '02 06' ) {
182 warn "ERROR ",as_hex($rest);
184 warn "FIXME unsuported ",as_hex($rest);
188 warn "# tag_blocks ",dump($tag_blocks);