lib/RFID/Serial/3M810.pm

   1 package RFID::Serial::3M810;
   2
   3 use base 'RFID::Serial';
   4 use RFID::Serial;
   5
   6 use Data::Dump qw(dump);
   7 use Carp qw(confess);
   8 use Time::HiRes;
   9 use Digest::CRC;
  10
  11 sub serial_settings {{
  12         device    => "/dev/ttyUSB1", # FIXME comment out before shipping
  13         baudrate  => "19200",
  14         databits  => "8",
  15         parity    => "none",
  16         stopbits  => "1",
  17         handshake => "none",
  18 }}
  19
  20 my $port;
  21 sub init {
  22         my $self = shift;
  23         $port = $self->port;
  24
  25         # drain on startup
  26         my ( $count, $str ) = $port->read(3);
  27         my $data = $port->read( ord(substr($str,2,1)) );
  28         warn "drain ",as_hex( $str, $data ),"\n";
  29
  30         setup();
  31
  32 }
  33
  34 sub checksum {
  35         my $bytes = shift;
  36         my $crc = Digest::CRC->new(
  37                 # midified CCITT to xor with 0xffff instead of 0x0000
  38                 width => 16, init => 0xffff, xorout => 0xffff, refout => 0, poly => 0x1021, refin => 0,
  39         ) or die $!;
  40         $crc->add( $bytes );
  41         pack('n', $crc->digest);
  42 }
  43
  44 sub wait_device {
  45         Time::HiRes::sleep 0.015;
  46 }
  47
  48 sub cmd {
  49         my ( $hex, $description, $coderef ) = @_;
  50         my $bytes = hex2bytes($hex);
  51         if ( substr($bytes,0,1) !~ /(\xD5|\xD6)/ ) {
  52                 my $len = pack( 'n', length( $bytes ) + 2 );
  53                 $bytes = $len . $bytes;
  54                 my $checksum = checksum($bytes);
  55                 $bytes = "\xD6" . $bytes . $checksum;
  56         }
  57
  58         warn ">> ", as_hex( $bytes ), "\t\t[$description]\n";
  59         $port->write( $bytes );
  60
  61         wait_device;
  62
  63         my $r_len = $port->read(3);
  64
  65         while ( ! $r_len ) {
  66                 wait_device;
  67                 $r_len = $port->read(3);
  68         }
  69
  70         wait_device;
  71
  72         my $len = ord( substr($r_len,2,1) );
  73         $data = $port->read( $len );
  74         warn "<< ", as_hex($r_len,$data)," $len\n";
  75
  76         $coderef->( $data ) if $coderef;
  77
  78 }
  79
  80 sub assert {
  81         my ( $got, $expected ) = @_;
  82         $expected = hex2bytes($expected);
  83
  84         my $len = length($got);
  85         $len = length($expected) if length $expected < $len;
  86
  87         confess "got ", as_hex($got), " expected ", as_hex($expected)
  88         unless substr($got,0,$len) eq substr($expected,0,$len);
  89
  90         return substr($got,$len);
  91 }
  92
  93 sub setup {
  94
  95 cmd(
  96 'D5 00  05   04 00 11   8C66', 'hw version', sub {
  97         my $data = shift;
  98         my $rest = assert $data => '04 00 11';
  99         my $hw_ver = join('.', unpack('CCCC', $rest));
 100         print "hardware version $hw_ver\n";
 101 });
 102
 103 cmd(
 104 '13  04 01 00 02 00 03 00 04 00','FIXME: stats? rf-on?', sub { assert(shift,
 105 '13  00 02 01 01 03 02 02 03 00'
 106 )});
 107 }
 108
 109 =head2 inventory
 110
 111   my @tags = inventory;
 112
 113 =cut
 114
 115 sub inventory {
 116
 117         my @tags;
 118
 119 cmd( 'FE  00 05', 'scan for tags', sub {
 120         my $data = shift;
 121         my $rest = assert $data => 'FE 00 00 05';
 122         my $nr = ord( substr( $rest, 0, 1 ) );
 123
 124         if ( ! $nr ) {
 125                 warn "# no tags in range\n";
 126         } else {
 127                 my $tags = substr( $rest, 1 );
 128                 my $tl = length( $tags );
 129                 die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
 130
 131                 foreach ( 0 .. $nr - 1 ) {
 132                         push @tags, tag_hex substr($tags, $_ * 8, 8);
 133                 }
 134         }
 135
 136 });
 137
 138         warn "# tags ",dump @tags;
 139         return @tags;
 140 }
 141
 142
 143 # 3M defaults: 8,4
 144 # cards 16, stickers: 8
 145 my $max_rfid_block = 8;
 146 my $blocks = 8;
 147
 148 sub _matched {
 149         my ( $data, $hex ) = @_;
 150         my $b = hex2bytes $hex;
 151         my $l = length($b);
 152         if ( substr($data,0,$l) eq $b ) {
 153                 warn "_matched $hex [$l] in ",as_hex($data);
 154                 return substr($data,$l);
 155         }
 156 }
 157
 158 sub read_blocks {
 159         my $tag = shift || confess "no tag?";
 160         $tag = shift if ref($tag);
 161
 162         my $tag_blocks;
 163         my $start = 0;
 164         cmd(
 165                  sprintf( "02 $tag %02x %02x", $start, $blocks ) => "read_blocks $tag $start/$blocks", sub {
 166                         my $data = shift;
 167                         if ( my $rest = _matched $data => '02 00' ) {
 168
 169                                 my $tag = hex_tag substr($rest,0,8);
 170                                 my $blocks = ord(substr($rest,8,1));
 171                                 warn "# response from $tag $blocks blocks ",as_hex substr($rest,9);
 172                                 foreach ( 1 .. $blocks ) {
 173                                         my $pos = ( $_ - 1 ) * 6 + 9;
 174                                         my $nr = unpack('v', substr($rest,$pos,2));
 175                                         my $payload = substr($rest,$pos+2,4);
 176                                         warn "## pos $pos block $nr ",as_hex($payload), $/;
 177                                         $tag_blocks->{$tag}->[$nr] = $payload;
 178                                 }
 179                         } elsif ( my $rest = _matched $data => 'FE 00 00 05 01' ) {
 180                                 warn "FIXME ready? ",as_hex $test;
 181                         } elsif ( my $rest = _matched $data => '02 06' ) {
 182                                 warn "ERROR ",as_hex($rest);
 183                         } else {
 184                                 die "FIXME unsuported ",as_hex($rest);
 185                         }
 186         });
 187
 188         warn "# tag_blocks ",dump($tag_blocks);
 189 }
 190
 191 1