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 sub tag_hex { uc(unpack('H16', shift)) }
 110
 111 sub inventory {
 112
 113         my $inventory;
 114
 115 cmd( 'FE  00 05', 'scan for tags', sub {
 116         my $data = shift;
 117         my $rest = assert $data => 'FE 00 00 05';
 118         my $nr = ord( substr( $rest, 0, 1 ) );
 119
 120         if ( ! $nr ) {
 121                 warn "# no tags in range\n";
 122         } else {
 123                 my $tags = substr( $rest, 1 );
 124                 my $tl = length( $tags );
 125                 die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
 126
 127                 foreach ( 0 .. $nr - 1 ) {
 128                         my $tag = tag_hex substr($tags, $_ * 8, 8);
 129                         $invetory->{$tag} ||= read_tag($tag);
 130                 }
 131         }
 132
 133 });
 134
 135         return $invetory;
 136 }
 137
 138
 139 # 3M defaults: 8,4
 140 # cards 16, stickers: 8
 141 my $max_rfid_block = 8;
 142 my $blocks = 8;
 143
 144 sub _matched {
 145         my ( $data, $hex ) = @_;
 146         my $b = hex2bytes $hex;
 147         my $l = length($b);
 148         if ( substr($data,0,$l) eq $b ) {
 149                 warn "_matched $hex [$l] in ",as_hex($data);
 150                 return substr($data,$l);
 151         }
 152 }
 153
 154 sub read_tag {
 155         my $tag = shift || confess "no tag?";
 156         warn "# read $tag\n";
 157
 158         my $tag_blocks;
 159         my $start = 0;
 160         cmd(
 161                  sprintf( "02 $tag %02x %02x", $start, $blocks ) => "read $tag $start/$blocks", sub {
 162                         my $data = shift;
 163                         if ( my $rest = _matched $data => '02 00' ) {
 164
 165                                 my $tag = tag_hex substr($rest,0,8);
 166                                 my $blocks = ord(substr($rest,8,1));
 167                                 warn "# response from $tag $blocks blocks ",as_hex substr($rest,9);
 168                                 foreach ( 1 .. $blocks ) {
 169                                         my $pos = ( $_ - 1 ) * 6 + 9;
 170                                         my $nr = unpack('v', substr($rest,$pos,2));
 171                                         my $payload = substr($rest,$pos+2,4);
 172                                         warn "## pos $pos block $nr ",as_hex($payload), $/;
 173                                         $tag_blocks->{$tag}->[$nr] = $payload;
 174                                 }
 175                         } elsif ( my $rest = _matched $data => 'FE 00 00 05 01' ) {
 176                                 warn "FIXME ready? ",as_hex $test;
 177                         } elsif ( my $rest = _matched $data => '02 06' ) {
 178                                 warn "ERROR ",as_hex($rest);
 179                         }
 180         });
 181
 182         warn "# tag_blocks ",dump($tag_blocks);
 183 }
 184
 185 1