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

diff --git a/lib/RFID/Serial/3M810.pm b/lib/RFID/Serial/3M810.pm
index 5aaf78b..8fffb78 100644
--- a/lib/RFID/Serial/3M810.pm
+++ b/lib/RFID/Serial/3M810.pm
@@ -62,16 +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;
 
@@ -97,7 +108,7 @@ cmd(
 	my $data = shift;
 	my $rest = assert $data => '04 00 11';
 	my $hw_ver = join('.', unpack('CCCC', $rest));
-	print "hardware version $hw_ver\n";
+	warn "# 3M 810 hardware version $hw_ver\n";
 });
 
 cmd(
@@ -106,11 +117,15 @@ cmd(
 )});
 }
 
-sub tag_hex { uc(unpack('H16', shift)) }
+=head2 inventory
+
+  my @tags = inventory;
+
+=cut
 
 sub inventory {
 
-	my $inventory;
+	my @tags;
 
 cmd( 'FE  00 05', 'scan for tags', sub {
 	my $data = shift;
@@ -125,14 +140,14 @@ cmd( 'FE  00 05', 'scan for tags', sub {
 		die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
 
 		foreach ( 0 .. $nr - 1 ) {
-			my $tag = tag_hex substr($tags, $_ * 8, 8);
-			$invetory->{$tag} ||= read_tag($tag);
+			push @tags, hex_tag substr($tags, $_ * 8, 8);
 		}
 	}
 
 });
 
-	return $invetory;
+	warn "# tags ",dump @tags;
+	return @tags;
 }
 
 
@@ -151,18 +166,18 @@ sub _matched {
 	}
 }
 
-sub read_tag {
+sub read_blocks {
 	my $tag = shift || confess "no tag?";
-	warn "# read $tag\n";
+	$tag = shift if ref($tag);
 
 	my $tag_blocks;
 	my $start = 0;
 	cmd(
-		 sprintf( "02 $tag %02x %02x", $start, $blocks ) => "read $tag $start/$blocks", sub {
+		 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 = tag_hex substr($rest,0,8);
+				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 ) {
@@ -176,10 +191,102 @@ sub read_tag {
 				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