X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=lib%2FRFID%2FSerial%2F3M810.pm;h=41e125c403b9d947877d454347cb79e1730650f8;hb=7832e5544c3d3e1535e3f019c939947265a0a7ae;hp=129f02faad75ec9af2f1ad3467aead10f454d972;hpb=40f3145f0d397a1c2d769aa91614a1438ca0c72f;p=Biblio-RFID.git

diff --git a/lib/RFID/Serial/3M810.pm b/lib/RFID/Serial/3M810.pm
index 129f02f..41e125c 100644
--- a/lib/RFID/Serial/3M810.pm
+++ b/lib/RFID/Serial/3M810.pm
@@ -3,8 +3,13 @@ package RFID::Serial::3M810;
 use base 'RFID::Serial';
 use RFID::Serial;
 
+use Data::Dump qw(dump);
+use Carp qw(confess);
+use Time::HiRes;
+use Digest::CRC;
+
 sub serial_settings {{
-	device    => "/dev/ttyUSB0",
+	device    => "/dev/ttyUSB1", # FIXME comment out before shipping
 	baudrate  => "19200",
 	databits  => "8",
 	parity	  => "none",
@@ -12,29 +17,61 @@ sub serial_settings {{
 	handshake => "none",
 }}
 
+my $port;
+sub init {
+	my $self = shift;
+	$port = $self->port;
+
+	# 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";
+
+	setup();
+
+}
+
+sub checksum {
+	my $bytes = shift;
+	my $crc = Digest::CRC->new(
+		# midified CCITT to xor with 0xffff instead of 0x0000
+		width => 16, init => 0xffff, xorout => 0xffff, refout => 0, poly => 0x1021, refin => 0,
+	) or die $!;
+	$crc->add( $bytes );
+	pack('n', $crc->digest);
+}
+
+sub wait_device {
+	Time::HiRes::sleep 0.015;
+}
+
 sub cmd {
 	my ( $hex, $description, $coderef ) = @_;
 	my $bytes = hex2bytes($hex);
-	if ( substr($bytes,0,1) ne "\xD5" ) {
-		my $len = pack( 'c', length( $bytes ) + 3 );
+	if ( substr($bytes,0,1) !~ /(\xD5|\xD6)/ ) {
+		my $len = pack( 'n', length( $bytes ) + 2 );
 		$bytes = $len . $bytes;
 		my $checksum = checksum($bytes);
-		$bytes = "\xD6\x00" . $bytes . $checksum;
+		$bytes = "\xD6" . $bytes . $checksum;
 	}
 
 	warn ">> ", as_hex( $bytes ), "\t\t[$description]\n";
 	$port->write( $bytes );
 
+	wait_device;
+
 	my $r_len = $port->read(3);
 
 	while ( ! $r_len ) {
-		warn "# wait for response length 5ms\n";
+		wait_device;
 		$r_len = $port->read(3);
 	}
 
-	my $data_len = ord(substr($r_len,2,1)) - 1;
-	my $data = $port->read( $data_len );
-	warn "<< ", as_hex( $r_len . $data ),"\n";
+	wait_device;
+
+	my $len = ord( substr($r_len,2,1) );
+	$data = $port->read( $len );
+	warn "<< ", as_hex($r_len,$data)," $len\n";
 
 	$coderef->( $data ) if $coderef;
 
@@ -42,25 +79,113 @@ sub cmd {
 
 sub assert {
 	my ( $got, $expected ) = @_;
-	die "got ", as_hex($got), " expected ", as_hex($expected)
-	unless substr($expected,0,length($got)) eq $got;
+	$expected = hex2bytes($expected);
+
+	my $len = length($got);
+	$len = length($expected) if length $expected < $len;
+
+	confess "got ", as_hex($got), " expected ", as_hex($expected)
+	unless substr($got,0,$len) eq substr($expected,0,$len);
+
+	return substr($got,$len);
 }
 
-sub init {
-	my $self = shift;
+sub setup {
 
-cmd( 'D5 00  05   04 00 11' => 'hw version' . sub {
+cmd(
+'D5 00  05   04 00 11   8C66', 'hw version', sub {
 	my $data = shift;
-	assert $data => '04 00 01';
-	my $hw_ver = join('.', unpack('CCCC', substr($data,3)));
+	my $rest = assert $data => '04 00 11';
+	my $hw_ver = join('.', unpack('CCCC', $rest));
 	print "hardware version $hw_ver\n";
 });
 
 cmd(
-'13  04  01 00 02 00 03 00 04 00', 'FIXME: stats?', sub { assert(shift,
-'13  00  02 01 01 03 02 02 03 00'
+'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 @tags;
+
+cmd( 'FE  00 05', 'scan for tags', sub {
+	my $data = shift;
+	my $rest = assert $data => 'FE 00 00 05';
+	my $nr = ord( substr( $rest, 0, 1 ) );
+
+	if ( ! $nr ) {
+		warn "# no tags in range\n";
+	} else {
+		my $tags = substr( $rest, 1 );
+		my $tl = length( $tags );
+		die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
+
+		foreach ( 0 .. $nr - 1 ) {
+			push @tags, tag_hex substr($tags, $_ * 8, 8);
+		}
+	}
+
+});
+
+	warn "# tags ",dump @tags;
+	return @tags;
+}
+
+
+# 3M defaults: 8,4
+# cards 16, stickers: 8
+my $max_rfid_block = 8;
+my $blocks = 8;
+
+sub _matched {
+	my ( $data, $hex ) = @_;
+	my $b = hex2bytes $hex;
+	my $l = length($b);
+	if ( substr($data,0,$l) eq $b ) {
+		warn "_matched $hex [$l] in ",as_hex($data);
+		return substr($data,$l);
+	}
+}
+
+sub read_blocks {
+	my $tag = shift || confess "no tag?";
+	$tag = shift if ref($tag);
+
+	my $tag_blocks;
+	my $start = 0;
+	cmd(
+		 sprintf( "02 $tag %02x %02x", $start, $blocks ) => "read_blocks $tag $start/$blocks", sub {
+			my $data = shift;
+			if ( my $rest = _matched $data => '02 00' ) {
+
+				my $tag = hex_tag substr($rest,0,8);
+				my $blocks = ord(substr($rest,8,1));
+				warn "# response from $tag $blocks blocks ",as_hex substr($rest,9);
+				foreach ( 1 .. $blocks ) {
+					my $pos = ( $_ - 1 ) * 6 + 9;
+					my $nr = unpack('v', substr($rest,$pos,2));
+					my $payload = substr($rest,$pos+2,4);
+					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' ) {
+				warn "ERROR ",as_hex($rest);
+			} else {
+				die "FIXME unsuported ",as_hex($rest);
+			}
+	});
 
+	warn "# tag_blocks ",dump($tag_blocks);
 }
 
 1