1 package RFID::Biblio::Reader::3M810;
5 RFID::Biblio::Reader::3M810 - support for 3M 810 RFID reader
9 This module implement serial protocol (over USB/serial adapter) with 3M 810 RFID
10 reader, often used in library applications.
12 This is most complete implementation which supports full API defined
13 in L<RFID::Biblio>. This include scanning for all tags in reader
14 range, reading and writing of data, and AFI security manipulation.
16 This implementation is developed using Portmon on Windows to capture serial traffic
17 L<http://technet.microsoft.com/en-us/sysinternals/bb896644.aspx>
19 Checksum for this reader is developed using help from C<selwyn>
20 L<http://stackoverflow.com/questions/149617/how-could-i-guess-a-checksum-algorithm>
27 use base 'RFID::Biblio::Reader::Serial';
30 use Data::Dump qw(dump);
35 sub serial_settings {{
36 device => "/dev/ttyUSB1", # FIXME comment out before shipping
50 $port->read_char_time(0);
51 $port->read_const_time(0);
54 my ( $count, $str ) = $port->read(3);
55 my $data = $port->read( ord(substr($str,2,1)) );
56 warn "drain ",as_hex( $str, $data ),"\n";
58 $port->read_char_time(100); # 0.1 s char timeout
59 $port->read_const_time(500); # 0.5 s read timeout
67 my $crc = Digest::CRC->new(
68 # midified CCITT to xor with 0xffff instead of 0x0000
69 width => 16, init => 0xffff, xorout => 0xffff, refout => 0, poly => 0x1021, refin => 0,
72 pack('n', $crc->digest);
76 Time::HiRes::sleep 0.015;
80 my ( $hex, $description, $coderef ) = @_;
81 my $bytes = hex2bytes($hex);
82 if ( substr($bytes,0,1) !~ /(\xD5|\xD6)/ ) {
83 my $len = pack( 'n', length( $bytes ) + 2 );
84 $bytes = $len . $bytes;
85 my $checksum = checksum($bytes);
86 $bytes = "\xD6" . $bytes . $checksum;
89 warn ">> ", as_hex( $bytes ), "\t\t[$description]\n";
90 $port->write( $bytes );
94 my $r_len = $port->read(3);
96 while ( length($r_len) < 3 ) {
98 $r_len = $port->read( 3 - length($r_len) );
103 my $len = ord( substr($r_len,2,1) );
104 my $data = $port->read( $len );
106 while ( length($data) < $len ) {
107 warn "# short read ", length($data), " < $len\n";
109 $data .= $port->read( $len - length($data) );
112 warn "<< ", as_hex($r_len,$data),
114 substr($data,-2,2) eq checksum(substr($r_len,1).substr($data,0,-2)) ? 'OK' : 'ERROR',
118 $coderef->( $data ) if $coderef;
123 my ( $got, $expected ) = @_;
124 $expected = hex2bytes($expected);
126 my $len = length($got);
127 $len = length($expected) if length $expected < $len;
129 confess "got ", as_hex($got), " expected ", as_hex($expected)
130 unless substr($got,0,$len) eq substr($expected,0,$len);
132 return substr($got,$len);
138 'D5 00 05 04 00 11 8C66', 'hw version', sub {
140 my $rest = assert $data => '04 00 11';
141 my $hw_ver = join('.', unpack('CCCC', $rest));
142 warn "# 3M 810 hardware version $hw_ver\n";
146 '13 04 01 00 02 00 03 00 04 00','FIXME: stats? rf-on?', sub { assert(shift,
147 '13 00 02 01 01 03 02 02 03 00'
153 my @tags = inventory;
161 cmd( 'FE 00 05', 'scan for tags', sub {
163 my $rest = assert $data => 'FE 00 00 05';
164 my $nr = ord( substr( $rest, 0, 1 ) );
167 warn "# no tags in range\n";
169 my $tags = substr( $rest, 1 );
170 my $tl = length( $tags );
171 die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
173 foreach ( 0 .. $nr - 1 ) {
174 push @tags, hex_tag substr($tags, $_ * 8, 8);
180 warn "# tags ",dump @tags;
186 # cards 16, stickers: 8
187 my $max_rfid_block = 8;
191 my ( $data, $hex ) = @_;
192 my $b = hex2bytes $hex;
194 if ( substr($data,0,$l) eq $b ) {
195 warn "_matched $hex [$l] in ",as_hex($data);
196 return substr($data,$l);
201 my $tag = shift || confess "no tag?";
202 $tag = shift if ref($tag);
207 sprintf( "02 $tag %02x %02x", $start, $blocks ) => "read_blocks $tag $start/$blocks", sub {
209 if ( my $rest = _matched $data => '02 00' ) {
211 my $tag = hex_tag substr($rest,0,8);
212 my $blocks = ord(substr($rest,8,1));
213 warn "# response from $tag $blocks blocks ",as_hex substr($rest,9);
214 foreach ( 1 .. $blocks ) {
215 my $pos = ( $_ - 1 ) * 6 + 9;
216 my $nr = unpack('v', substr($rest,$pos,2));
217 my $payload = substr($rest,$pos+2,4);
218 warn "## pos $pos block $nr ",as_hex($payload), $/;
219 $tag_blocks->{$tag}->[$nr] = $payload;
221 } elsif ( $rest = _matched $data => 'FE 00 00 05 01' ) {
222 warn "FIXME ready? ",as_hex $rest;
223 } elsif ( $rest = _matched $data => '02 06' ) {
224 warn "ERROR ",as_hex($rest);
226 warn "FIXME unsuported ",as_hex($rest);
230 warn "# tag_blocks ",dump($tag_blocks);
236 $tag = shift if ref $tag;
239 $data = join('', @$data) if ref $data eq 'ARRAY';
241 warn "## write_blocks ",dump($tag,$data);
243 if ( length($data) % 4 ) {
244 $data .= '\x00' x ( 4 - length($data) % 4 );
245 warn "# padded data to ",dump($data);
248 my $hex_data = as_hex $data;
249 my $blocks = sprintf('%02x', length($data) / 4 );
252 "04 $tag 00 $blocks 00 $hex_data", "write_blocks $tag [$blocks] $hex_data", sub {
254 if ( my $rest = _matched $data => '04 00' ) {
255 my $tag = substr($rest,0,8);
256 my $blocks = substr($rest,8,1);
257 warn "# WRITE ",as_hex($tag), " [$blocks]\n";
258 } elsif ( $rest = _matched $data => '04 06' ) {
259 warn "ERROR ",as_hex($rest);
270 $tag = shift if ref $tag;
275 "0A $tag", "read_afi $tag", sub {
278 if ( my $rest = _matched $data => '0A 00' ) {
280 my $tag = substr($rest,0,8);
281 $afi = substr($rest,8,1);
283 warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
285 } elsif ( $rest = _matched $data => '0A 06' ) {
286 warn "ERROR reading security from $tag ", as_hex($data);
288 warn "IGNORED ",as_hex($data);
291 warn "## read_afi ",dump($tag, $afi);
297 $tag = shift if ref $tag;
298 my $afi = shift || die "no afi?";
303 "09 $tag $afi", "write_afi $tag $afi", sub {
306 if ( my $rest = _matched $data => '09 00' ) {
307 my $tag_back = hex_tag substr($rest,0,8);
308 die "write_afi got $tag_back expected $tag" if $tag_back ne $tag;
309 warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
310 } elsif ( $rest = _matched $data => '0A 06' ) {
311 warn "ERROR writing AFI to $tag ", as_hex($data);
314 warn "IGNORED ",as_hex($data);
318 warn "## write_afi ", dump( $tag, $afi );