From 3db46a9022a156cbe1398647db26d89030dcd3b8 Mon Sep 17 00:00:00 2001
From: Dobrica Pavlinusic <dpavlin@rot13.org>
Date: Tue, 3 Aug 2010 15:28:48 +0200
Subject: [PATCH] Write Multiple Blocks

---
 lib/RFID/Biblio/CPRM02.pm | 25 +++++++++++++++++++++++++
 t/20-CPR-M02.t            | 14 +++++++++++++-
 2 files changed, 38 insertions(+), 1 deletion(-)

diff --git a/lib/RFID/Biblio/CPRM02.pm b/lib/RFID/Biblio/CPRM02.pm
index 057db95..ec2efdd 100644
--- a/lib/RFID/Biblio/CPRM02.pm
+++ b/lib/RFID/Biblio/CPRM02.pm
@@ -196,4 +196,29 @@ sub read_blocks {
 }
 
 
+sub write_blocks {
+	my $tag = shift;
+	$tag = shift if ref $tag;
+
+	my $data = shift;
+	$data = join('', @$data) if ref $data eq 'ARRAY';
+
+	my $DB_ADR  = 0; # start at first block
+	my $DB_SIZE = 4; # bytes in one block FIXME this should be read from transponder and not hard-coded
+	if ( my $padding = length($data) % $DB_SIZE ) {
+		warn "WARNING: data block not padded to $DB_SIZE bytes";
+		$data .= "\x00" x $padding;
+	}
+	my $DB_N    = length($data) / $DB_SIZE;
+
+	cpr( sprintf("FF  B0 24  01  $tag   %02x %02x %02x  %s", $DB_ADR, $DB_SIZE, $DB_N, as_hex($data)), "Write Multiple Blocks $tag", sub {
+		my $data = shift;
+		warn dump( $data );
+	});
+
+}
+
+sub read_afi {}
+sub write_afi {}
+
 1
diff --git a/t/20-CPR-M02.t b/t/20-CPR-M02.t
index cf6899a..4e2278c 100755
--- a/t/20-CPR-M02.t
+++ b/t/20-CPR-M02.t
@@ -13,7 +13,19 @@ ok( my $o = RFID::Biblio::CPRM02->new( device => '/dev/ttyUSB0' ), 'new' );
 
 ok( my @tags = $o->inventory, 'inventory' );
 
-ok( my $blocks = $o->read_blocks( $_ ), "read_blocks $_" ) foreach @tags;
+foreach my $tag ( @tags ) {
+
+	ok( my $blocks = $o->read_blocks( $tag ), "read_blocks $tag" );
+
+	my $pattern = "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B\x0C\x0D\x0E\x0F";
+	ok( $o->write_blocks( $tag, $pattern ), "write_blocks $tag" );
+	
+	$pattern = "0123456789ABCDEF.....";
+	ok( $o->write_blocks( $tag, $pattern ), "write_blocks $tag" );
+
+#	ok( $o->write_blocks( $tag, $blocks->{$tag} ), "write_blocks $tag" );
+
+}
 
 ok( my $visible = $o->scan, 'scan' );
 diag dump $visible;
-- 
2.20.1