=head1 DESCRIPTION
-This module implement serial protocol (over USB/serial adapter) with 3M 810 RFID
-reader, often used in library applications.
+This module uses L<RFID::Biblio::Reader::Serial> over USB/serial adapter
+with 3M 810 RFID reader, often used in library applications.
-This is most complete implementation which supports full API defined
-in L<RFID::Biblio>. This include scanning for all tags in reader
+This is most mature implementation which supports full API defined
+in L<RFID::Biblio::Reader::API>. This include scanning for all tags in reader
range, reading and writing of data, and AFI security manipulation.
This implementation is developed using Portmon on Windows to capture serial traffic
Checksum for this reader is developed using help from C<selwyn>
L<http://stackoverflow.com/questions/149617/how-could-i-guess-a-checksum-algorithm>
+More inforation about process of reverse engeeniring protocol with
+this reader is available at L<http://blog.rot13.org/rfid/>
+
=cut
use warnings;
use strict;
-use base 'RFID::Biblio';
+use base 'RFID::Biblio::Reader::Serial';
use RFID::Biblio;
use Data::Dump qw(dump);
use Digest::CRC;
sub serial_settings {{
- device => "/dev/ttyUSB1", # FIXME comment out before shipping
baudrate => "19200",
databits => "8",
parity => "none",
handshake => "none",
}}
+sub assert;
+
my $port;
sub init {
my $self = shift;
# drain on startup
my ( $count, $str ) = $port->read(3);
- my $data = $port->read( ord(substr($str,2,1)) );
- warn "drain ",as_hex( $str, $data ),"\n";
+ if ( $count ) {
+ my $data = $port->read( ord(substr($str,2,1)) );
+ warn "drain ",as_hex( $str, $data ),"\n";
+ }
$port->read_char_time(100); # 0.1 s char timeout
$port->read_const_time(500); # 0.5 s read timeout
- setup();
+ $port->write( hex2bytes( 'D5 00 05 04 00 11 8C66' ) );
+ # hw-version expect: 'D5 00 09 04 00 11 0A 05 00 02 7250'
+ my $data = $port->read( 12 );
+ return unless $data;
+
+ warn "# probe response: ",as_hex($data);
+ if ( my $rest = assert $data => 'D5 00 09 04 00 11' ) {
+ my $hw_ver = join('.', unpack('CCCC', $rest));
+ warn "# 3M 810 hardware version $hw_ver\n";
+ cmd(
+'13 04 01 00 02 00 03 00 04 00','FIXME: stats? rf-on?', sub { assert(shift,
+'13 00 02 01 01 03 02 02 03 00'
+ )});
+
+ return $hw_ver;
+ }
+
+ return;
}
sub checksum {
pack('n', $crc->digest);
}
-sub wait_device {
- Time::HiRes::sleep 0.015;
-}
-
sub cmd {
my ( $hex, $description, $coderef ) = @_;
my $bytes = hex2bytes($hex);
$bytes = "\xD6" . $bytes . $checksum;
}
- warn ">> ", as_hex( $bytes ), "\t\t[$description]\n";
+ warn ">> ", as_hex( $bytes ), "\t\t[$description]\n" if $debug;
$port->write( $bytes );
- wait_device;
-
my $r_len = $port->read(3);
while ( length($r_len) < 3 ) {
- wait_device;
$r_len = $port->read( 3 - length($r_len) );
}
- wait_device;
-
my $len = ord( substr($r_len,2,1) );
my $data = $port->read( $len );
- while ( length($data) < $len ) {
- warn "# short read ", length($data), " < $len\n";
- wait_device;
- $data .= $port->read( $len - length($data) );
- }
-
warn "<< ", as_hex($r_len,$data),
' | ',
substr($data,-2,2) eq checksum(substr($r_len,1).substr($data,0,-2)) ? 'OK' : 'ERROR',
- " $len bytes\n";
+ " $len bytes\n" if $debug;
$coderef->( $data ) if $coderef;
return substr($got,$len);
}
-sub setup {
-
-cmd(
-'D5 00 05 04 00 11 8C66', 'hw version', sub {
- my $data = shift;
- my $rest = assert $data => '04 00 11';
- my $hw_ver = join('.', unpack('CCCC', $rest));
- warn "# 3M 810 hardware version $hw_ver\n";
-});
-
-cmd(
-'13 04 01 00 02 00 03 00 04 00','FIXME: stats? rf-on?', sub { assert(shift,
-'13 00 02 01 01 03 02 02 03 00'
-)});
-}
-
-=head2 inventory
-
- my @tags = inventory;
-
-=cut
sub inventory {
my $b = hex2bytes $hex;
my $l = length($b);
if ( substr($data,0,$l) eq $b ) {
- warn "_matched $hex [$l] in ",as_hex($data);
+ warn "_matched $hex [$l] in ",as_hex($data) if $debug;
return substr($data,$l);
}
}
} elsif ( $rest = _matched $data => 'FE 00 00 05 01' ) {
warn "FIXME ready? ",as_hex $rest;
} elsif ( $rest = _matched $data => '02 06' ) {
- warn "ERROR ",as_hex($rest);
+ die "ERROR ",as_hex($rest);
} else {
- warn "FIXME unsuported ",as_hex($rest);
+ die "FIXME unsuported ",as_hex($rest);
}
});
my $blocks = substr($rest,8,1);
warn "# WRITE ",as_hex($tag), " [$blocks]\n";
} elsif ( $rest = _matched $data => '04 06' ) {
- warn "ERROR ",as_hex($rest);
+ die "ERROR ",as_hex($rest);
} else {
die "UNSUPPORTED";
}
warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
} elsif ( $rest = _matched $data => '0A 06' ) {
- warn "ERROR reading security from $tag ", as_hex($data);
+ die "ERROR reading security from $tag ", as_hex($data);
} else {
- warn "IGNORED ",as_hex($data);
+ die "IGNORED ",as_hex($data);
}
});
warn "## read_afi ",dump($tag, $afi);
die "write_afi got $tag_back expected $tag" if $tag_back ne $tag;
warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
} elsif ( $rest = _matched $data => '0A 06' ) {
- warn "ERROR writing AFI to $tag ", as_hex($data);
- undef $afi;
+ die "ERROR writing AFI to $tag ", as_hex($data);
} else {
- warn "IGNORED ",as_hex($data);
- undef $afi;
+ die "IGNORED ",as_hex($data);
}
});
warn "## write_afi ", dump( $tag, $afi );
}
1
+
+__END__
+
+=head1 SEE ALSO
+
+L<RFID::Biblio::Reader::API>