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);
65 while ( length($r_len) < 3 ) {
67 $r_len = $port->read( 3 - length($r_len) );
72 my $len = ord( substr($r_len,2,1) );
73 $data = $port->read( $len );
75 while ( length($data) < $len ) {
76 warn "# short read ", length($data), " < $len\n";
78 $data .= $port->read( $len - length($data) );
81 warn "<< ", as_hex($r_len,$data),
83 substr($data,-2,2) eq checksum(substr($r_len,1).substr($data,0,-2)) ? 'OK' : 'ERROR',
87 $coderef->( $data ) if $coderef;
92 my ( $got, $expected ) = @_;
93 $expected = hex2bytes($expected);
95 my $len = length($got);
96 $len = length($expected) if length $expected < $len;
98 confess "got ", as_hex($got), " expected ", as_hex($expected)
99 unless substr($got,0,$len) eq substr($expected,0,$len);
101 return substr($got,$len);
107 'D5 00 05 04 00 11 8C66', 'hw version', sub {
109 my $rest = assert $data => '04 00 11';
110 my $hw_ver = join('.', unpack('CCCC', $rest));
111 warn "# 3M 810 hardware version $hw_ver\n";
115 '13 04 01 00 02 00 03 00 04 00','FIXME: stats? rf-on?', sub { assert(shift,
116 '13 00 02 01 01 03 02 02 03 00'
122 my @tags = inventory;
130 cmd( 'FE 00 05', 'scan for tags', sub {
132 my $rest = assert $data => 'FE 00 00 05';
133 my $nr = ord( substr( $rest, 0, 1 ) );
136 warn "# no tags in range\n";
138 my $tags = substr( $rest, 1 );
139 my $tl = length( $tags );
140 die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
142 foreach ( 0 .. $nr - 1 ) {
143 push @tags, hex_tag substr($tags, $_ * 8, 8);
149 warn "# tags ",dump @tags;
155 # cards 16, stickers: 8
156 my $max_rfid_block = 8;
160 my ( $data, $hex ) = @_;
161 my $b = hex2bytes $hex;
163 if ( substr($data,0,$l) eq $b ) {
164 warn "_matched $hex [$l] in ",as_hex($data);
165 return substr($data,$l);
170 my $tag = shift || confess "no tag?";
171 $tag = shift if ref($tag);
176 sprintf( "02 $tag %02x %02x", $start, $blocks ) => "read_blocks $tag $start/$blocks", sub {
178 if ( my $rest = _matched $data => '02 00' ) {
180 my $tag = hex_tag substr($rest,0,8);
181 my $blocks = ord(substr($rest,8,1));
182 warn "# response from $tag $blocks blocks ",as_hex substr($rest,9);
183 foreach ( 1 .. $blocks ) {
184 my $pos = ( $_ - 1 ) * 6 + 9;
185 my $nr = unpack('v', substr($rest,$pos,2));
186 my $payload = substr($rest,$pos+2,4);
187 warn "## pos $pos block $nr ",as_hex($payload), $/;
188 $tag_blocks->{$tag}->[$nr] = $payload;
190 } elsif ( my $rest = _matched $data => 'FE 00 00 05 01' ) {
191 warn "FIXME ready? ",as_hex $test;
192 } elsif ( my $rest = _matched $data => '02 06' ) {
193 warn "ERROR ",as_hex($rest);
195 warn "FIXME unsuported ",as_hex($rest);
199 warn "# tag_blocks ",dump($tag_blocks);
205 $tag = shift if ref $tag;
206 my $data = join('', @_);
208 warn "## write_blocks ",dump($tag,$data);
210 if ( length($data) % 4 ) {
211 $data .= '\x00' x ( 4 - length($data) % 4 );
212 warn "# padded data to ",dump($data);
215 my $hex_data = as_hex $data;
216 my $blocks = sprintf('%02x', length($data) / 4 );
219 "04 $tag 00 $blocks 00 $hex_data", "write_blocks $tag [$blocks] $hex_data", sub {
221 if ( my $rest = _matched $data => '04 00' ) {
222 my $tag = substr($rest,0,8);
223 my $blocks = substr($rest,8,1);
224 warn "# WRITE ",as_hex($tag), " [$blocks]\n";
225 } elsif ( my $rest = _matched $data => '04 06' ) {
226 warn "ERROR ",as_hex($rest);
237 $tag = shift if ref $tag;
242 "0A $tag", "read_afi $tag", sub {
245 if ( my $rest = _matched $data => '0A 00' ) {
247 my $tag = substr($rest,0,8);
248 $afi = substr($rest,8,1);
250 warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
252 } elsif ( my $rest = _matched $data => '0A 06' ) {
253 warn "ERROR reading security from $tag ", as_hex($data);
255 warn "IGNORED ",as_hex($data);
258 warn "## read_afi ",dump($tag, $afi);
264 $tag = shift if ref $tag;
265 my $afi = shift || die "no afi?";
270 "09 $tag $afi", "write_afi $tag $afi", sub {
273 if ( my $rest = _matched $data => '09 00' ) {
275 my $tag = substr($rest,0,8);
276 $afi = substr($rest,8,1);
278 warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
280 } elsif ( my $rest = _matched $data => '0A 06' ) {
281 warn "ERROR writing AFI to $tag ", as_hex($data);
284 warn "IGNORED ",as_hex($data);
288 warn "## write_afi ", dump( $tag, $afi );