package RFID::Biblio::3M810;
+=head1 NAME
+
+RFID::Biblio::3M810 - support for 3M 810 RFID reader
+
+=head1 DESCRIPTION
+
+This module implement serial protocol (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
+range, reading and writing of data, and AFI security manipulation.
+
+This implementation is developed using Portmon on Windows to capture serial traffic
+L<http://technet.microsoft.com/en-us/sysinternals/bb896644.aspx>
+
+Checksum for this reader is developed using help from C<selwyn>
+L<http://stackoverflow.com/questions/149617/how-could-i-guess-a-checksum-algorithm>
+
+=cut
+
+use warnings;
+use strict;
+
use base 'RFID::Biblio';
use RFID::Biblio;
my $self = shift;
$port = $self->port;
+ # disable timeouts
+ $port->read_char_time(0);
+ $port->read_const_time(0);
+
# 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";
+ $port->read_char_time(100); # 0.1 s char timeout
+ $port->read_const_time(500); # 0.5 s read timeout
+
setup();
}
wait_device;
my $len = ord( substr($r_len,2,1) );
- $data = $port->read( $len );
+ my $data = $port->read( $len );
while ( length($data) < $len ) {
warn "# short read ", length($data), " < $len\n";
warn "## pos $pos block $nr ",as_hex($payload), $/;
$tag_blocks->{$tag}->[$nr] = $payload;
}
- } elsif ( my $rest = _matched $data => 'FE 00 00 05 01' ) {
- warn "FIXME ready? ",as_hex $test;
- } elsif ( my $rest = _matched $data => '02 06' ) {
+ } 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);
} else {
warn "FIXME unsuported ",as_hex($rest);
sub write_blocks {
my $tag = shift;
$tag = shift if ref $tag;
- my $data = join('', @_);
+
+ my $data = shift;
+ $data = join('', @$data) if ref $data eq 'ARRAY';
warn "## write_blocks ",dump($tag,$data);
my $tag = substr($rest,0,8);
my $blocks = substr($rest,8,1);
warn "# WRITE ",as_hex($tag), " [$blocks]\n";
- } elsif ( my $rest = _matched $data => '04 06' ) {
+ } elsif ( $rest = _matched $data => '04 06' ) {
warn "ERROR ",as_hex($rest);
} else {
die "UNSUPPORTED";
warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
- } elsif ( my $rest = _matched $data => '0A 06' ) {
+ } elsif ( $rest = _matched $data => '0A 06' ) {
warn "ERROR reading security from $tag ", as_hex($data);
} else {
warn "IGNORED ",as_hex($data);
my $data = shift;
if ( my $rest = _matched $data => '09 00' ) {
-
- my $tag = substr($rest,0,8);
- $afi = substr($rest,8,1);
-
+ my $tag_back = hex_tag substr($rest,0,8);
+ die "write_afi got $tag_back expected $tag" if $tag_back ne $tag;
warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
-
- } elsif ( my $rest = _matched $data => '0A 06' ) {
+ } elsif ( $rest = _matched $data => '0A 06' ) {
warn "ERROR writing AFI to $tag ", as_hex($data);
undef $afi;
} else {