lib/RFID/Biblio/Reader/CPRM02.pm

   1 package RFID::Biblio::Reader::CPRM02;
   2
   3 =head1 NAME
   4
   5 RFID::Biblio::Reader::CPRM02 - support for CPR-M02 RFID reader
   6
   7 =head1 DESCRIPTION
   8
   9 This module implements serial protocol over usb/serial adapter with CPR-M02
  10 reader as described in document C<H20800-16e-ID-B.pdf>
  11
  12 =cut
  13
  14 use warnings;
  15 use strict;
  16
  17 use base 'RFID::Biblio::Reader::Serial';
  18 use RFID::Biblio;
  19
  20 use Time::HiRes;
  21 use Data::Dump qw(dump);
  22
  23 my $debug = 1;
  24
  25 sub serial_settings {{
  26         device    => "/dev/ttyUSB0",
  27         baudrate  => "38400",
  28         databits  => "8",
  29         parity    => "even",
  30         stopbits  => "1",
  31         handshake => "none",
  32 }}
  33
  34 sub cpr_m02_checksum {
  35         my $data = shift;
  36
  37         my $preset = 0xffff;
  38         my $polynom = 0x8408;
  39
  40         my $crc = $preset;
  41         foreach my $i ( 0 .. length($data) - 1 ) {
  42                 $crc ^= ord(substr($data,$i,1));
  43                 for my $j ( 0 .. 7 ) {
  44                         if ( $crc & 0x0001 ) {
  45                                 $crc = ( $crc >> 1 ) ^ $polynom;
  46                         } else {
  47                                 $crc = $crc >> 1;
  48                         }
  49                 }
  50 #               warn sprintf('%d %04x', $i, $crc & 0xffff);
  51         }
  52
  53         return pack('v', $crc);
  54 }
  55
  56 sub wait_device {
  57         Time::HiRes::sleep 0.010;
  58 }
  59
  60 our $port;
  61
  62 sub cpr {
  63         my ( $hex, $description, $coderef ) = @_;
  64         my $bytes = hex2bytes($hex);
  65         my $len = pack( 'c', length( $bytes ) + 3 );
  66         my $send = $len . $bytes;
  67         my $checksum = cpr_m02_checksum($send);
  68         $send .= $checksum;
  69
  70         warn "##>> ", as_hex( $send ), "\t\t[$description]\n";
  71         $port->write( $send );
  72
  73         wait_device;
  74
  75         my $r_len = $port->read(1);
  76
  77         my $count = 100;
  78         while ( ! $r_len ) {
  79                 if ( $count-- == 0 ) {
  80                         warn "no response from device";
  81                         return;
  82                 }
  83                 wait_device;
  84                 $r_len = $port->read(1);
  85         }
  86
  87         wait_device;
  88
  89         my $data_len = ord($r_len) - 1;
  90         my $data = $port->read( $data_len );
  91         warn "##<< ", as_hex( $r_len . $data ),"\n";
  92
  93         wait_device;
  94
  95         $coderef->( $data ) if $coderef;
  96
  97 }
  98
  99 # FF = COM-ADDR any
 100
 101 sub init {
 102         my $self = shift;
 103
 104         $port = $self->port;
 105
 106 cpr( 'FF  52 00',       'Boud Rate Detection' );
 107
 108 cpr( 'FF  65',          'Get Software Version' );
 109
 110 cpr( 'FF  66 00',       'Get Reader Info - General hard and firware' );
 111
 112 cpr( 'FF  69',          'RF Reset' );
 113
 114         return 1;
 115 }
 116
 117
 118 sub inventory {
 119
 120         my @tags;
 121
 122 cpr( 'FF  B0  01 00', 'ISO - Inventory', sub {
 123         my $data = shift;
 124         if (length($data) < 5 + 2 ) {
 125                 warn "# no tags in range\n";
 126                 return;
 127         }
 128
 129         my $data_sets = ord(substr($data,3,1));
 130         $data = substr($data,4);
 131         foreach ( 1 .. $data_sets ) {
 132                 my $tr_type = substr($data,0,1);
 133                 die "FIXME only TR-TYPE=3 ISO 15693 supported" unless $tr_type eq "\x03";
 134                 my $dsfid   = substr($data,1,1);
 135                 my $uid     = substr($data,2,8);
 136                 $data = substr($data,10);
 137                 warn "# TAG $_ ",as_hex( $tr_type, $dsfid, $uid ),$/;
 138                 push @tags, hex_tag $uid;
 139
 140         }
 141 });
 142
 143         warn "# tags ",dump(@tags),$/;
 144         return @tags;
 145 }
 146
 147
 148 sub _get_system_info {
 149         my $tag = shift;
 150
 151         my $info;
 152
 153         cpr( "FF  B0 2B  01  $tag", "Get System Information $tag", sub {
 154                 my $data = shift;
 155
 156                 warn "# data ",as_hex($data);
 157
 158                 $info = {
 159                         DSFID    => substr($data,5-2,1),
 160                         UID      => substr($data,6-2,8),
 161                         AFI      => substr($data,14-2,1),
 162                         MEM      => substr($data,15-2,1),
 163                         SIZE     => substr($data,16-2,1),
 164                         IC_REF   => substr($data,17-2,1),
 165                 };
 166
 167         });
 168
 169         warn "# _get_system_info $tag ",dump( $info );
 170
 171         return $info;
 172 }
 173
 174
 175 sub read_blocks {
 176         my $tag = shift;
 177         $tag = shift if ref $tag;
 178
 179         my $info = _get_system_info $tag;
 180
 181         my $max_block = ord($info->{SIZE}) || die "no SIZE in ",dump( $info );
 182
 183         my $tag_blocks;
 184
 185         my $block = 0;
 186         while ( $block < $max_block ) {
 187                 cpr( sprintf("FF  B0 23  01  $tag %02x 04", $block), "Read Multiple Blocks $block", sub {
 188                         my $data = shift;
 189
 190                         my $DB_N    = ord substr($data,5-2,1);
 191                         my $DB_SIZE = ord substr($data,6-2,1);
 192
 193                         $data = substr($data,7-2,-2);
 194 #                       warn "# DB N: $DB_N SIZE: $DB_SIZE ", as_hex( $data ), " transponder_data: [$transponder_data] ",length($transponder_data),"\n";
 195                         foreach my $n ( 1 .. $DB_N ) {
 196                                 my $sec = ord(substr($data,0,1));
 197                                 my $db  = substr($data,1,$DB_SIZE);
 198                                 warn "## block $n ",dump( $sec, $db ) if $debug;
 199                                 $tag_blocks->{$tag}->[$block+$n-1] = reverse split(//,$db);
 200                                 $data = substr($data, $DB_SIZE + 1);
 201                         }
 202                 });
 203                 $block += 4;
 204         }
 205
 206         warn "# tag_blocks ",dump($tag_blocks),$/;
 207         return $tag_blocks;
 208 }
 209
 210
 211 sub write_blocks {
 212         my $tag = shift;
 213         $tag = shift if ref $tag;
 214
 215         my $data = shift;
 216         $data = join('', @$data) if ref $data eq 'ARRAY';
 217
 218         my $DB_ADR  = 0; # start at first block
 219         my $DB_SIZE = 4; # bytes in one block FIXME this should be read from transponder and not hard-coded
 220         if ( my $padding = length($data) % $DB_SIZE ) {
 221                 warn "WARNING: data block not padded to $DB_SIZE bytes";
 222                 $data .= "\x00" x $padding;
 223         }
 224         my $DB_N    = length($data) / $DB_SIZE;
 225
 226         my $send_data;
 227         foreach my $block ( 0 .. $DB_N ) {
 228                 $send_data .= reverse split(//, substr( $data, $block * $DB_SIZE, $DB_SIZE ) );
 229         }
 230
 231         cpr( sprintf("FF  B0 24  01  $tag   %02x %02x %02x  %s", $DB_ADR, $DB_N, $DB_SIZE, as_hex($send_data)), "Write Multiple Blocks $tag", sub {
 232                 my $data = shift;
 233                 warn dump( $data );
 234         });
 235
 236 }
 237
 238 sub read_afi {
 239         my $tag = shift;
 240         $tag = shift if ref $tag;
 241
 242         my $info = _get_system_info $tag;
 243         return $info->{AFI} || die "no AFI for $tag in ",dump($info);
 244
 245 }
 246
 247 sub write_afi {
 248         my $tag = shift;
 249         $tag = shift if ref $tag;
 250
 251         my $afi = shift || die "no afi?";
 252         $afi = as_hex $afi;
 253
 254         cpr( "FF  B0  27  01  $tag  $afi", "Write AFI $tag $afi", sub {
 255                 my $data = shift;
 256                 warn "## write_afi $tag got ",as_hex($data);
 257         });
 258
 259 }
 260
 261 1