X-Git-Url: http://git.rot13.org/?p=Biblio-RFID.git;a=blobdiff_plain;f=lib%2FRFID%2FSerial%2F3M810.pm;h=8fffb787632fa2d875e1c74d699bd5b0923cca62;hp=6884b77c4c22fc2ec26beb4c717cb499bfe75640;hb=3cb0945eb525dbb10ce4b0f4b1f7bdb34911e8b4;hpb=7d08d49b6c40f43431c6c563c40dd13787ef4c5a

diff --git a/lib/RFID/Serial/3M810.pm b/lib/RFID/Serial/3M810.pm
index 6884b77..8fffb78 100644
--- a/lib/RFID/Serial/3M810.pm
+++ b/lib/RFID/Serial/3M810.pm
@@ -3,6 +3,7 @@ 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;
@@ -61,14 +62,27 @@ sub cmd {
 
 	my $r_len = $port->read(3);
 
-	while ( ! $r_len ) {
+	while ( length($r_len) < 3 ) {
 		wait_device;
-		$r_len = $port->read(3);
+		$r_len = $port->read( 3 - length($r_len) );
 	}
 
+	wait_device;
+
 	my $len = ord( substr($r_len,2,1) );
 	$data = $port->read( $len );
-	warn "<< ", as_hex($r_len,$data)," $len\n";
+
+	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";
+
 
 	$coderef->( $data ) if $coderef;
 
@@ -83,6 +97,8 @@ sub assert {
 
 	confess "got ", as_hex($got), " expected ", as_hex($expected)
 	unless substr($got,0,$len) eq substr($expected,0,$len);
+
+	return substr($got,$len);
 }
 
 sub setup {
@@ -90,9 +106,9 @@ sub setup {
 cmd(
 'D5 00  05   04 00 11   8C66', 'hw version', sub {
 	my $data = shift;
-	assert $data => '04 00 11';
-	my $hw_ver = join('.', unpack('CCCC', substr($data,3)));
-	print "hardware version $hw_ver\n";
+	my $rest = assert $data => '04 00 11';
+	my $hw_ver = join('.', unpack('CCCC', $rest));
+	warn "# 3M 810 hardware version $hw_ver\n";
 });
 
 cmd(
@@ -101,4 +117,176 @@ cmd(
 )});
 }
 
+=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, hex_tag 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 {
+				warn "FIXME unsuported ",as_hex($rest);
+			}
+	});
+
+	warn "# tag_blocks ",dump($tag_blocks);
+	return $tag_blocks;
+}
+
+sub write_blocks {
+	my $tag = shift;
+	$tag = shift if ref $tag;
+	my $data = join('', @_);
+
+	warn "## write_blocks ",dump($tag,$data);
+
+	if ( length($data) % 4 ) {
+		$data .= '\x00' x ( 4 - length($data) % 4 );
+		warn "# padded data to ",dump($data);
+	}
+
+	my $hex_data = as_hex $data;
+	my $blocks   = sprintf('%02x', length($data) / 4 );
+
+	cmd(
+		"04 $tag 00 $blocks 00 $hex_data", "write_blocks $tag [$blocks] $hex_data", sub {
+			my $data = shift;
+			if ( my $rest = _matched $data => '04 00' ) {
+				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' ) {
+				warn "ERROR ",as_hex($rest);
+			} else {
+				die "UNSUPPORTED";
+			}
+		}
+	);
+
+}
+
+sub read_afi {
+	my $tag = shift;
+	$tag = shift if ref $tag;
+
+	my $afi;
+
+	cmd(
+		"0A $tag", "read_afi $tag", sub {
+		my $data = shift;
+
+		if ( my $rest = _matched $data => '0A 00' ) {
+
+			my $tag = substr($rest,0,8);
+			   $afi = substr($rest,8,1);
+
+			warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
+
+		} elsif ( my $rest = _matched $data => '0A 06' ) {
+			warn "ERROR reading security from $tag ", as_hex($data);
+		} else {
+			warn "IGNORED ",as_hex($data);
+		}
+	});
+	warn "## read_afi ",dump($tag, $afi);
+	return $afi;
+}
+
+sub write_afi {
+	my $tag = shift;
+	$tag = shift if ref $tag;
+	my $afi = shift || die "no afi?";
+
+	$afi = as_hex $afi;
+
+	cmd(
+		"09 $tag $afi", "write_afi $tag $afi", sub {
+		my $data = shift;
+
+		if ( my $rest = _matched $data => '09 00' ) {
+
+			my $tag = substr($rest,0,8);
+			   $afi = substr($rest,8,1);
+
+			warn "# SECURITY ", hex_tag($tag), " AFI: ", as_hex($afi);
+
+		} elsif ( my $rest = _matched $data => '0A 06' ) {
+			warn "ERROR writing AFI to $tag ", as_hex($data);
+			undef $afi;
+		} else {
+			warn "IGNORED ",as_hex($data);
+			undef $afi;
+		}
+	});
+	warn "## write_afi ", dump( $tag, $afi );
+	return $afi;
+}
+
 1