lib/RFID/Serial/3M810.pm

   1 package RFID::Serial::3M810;
   2
   3 use base 'RFID::Serial';
   4 use RFID::Serial;
   5
   6 use Carp qw(confess);
   7 use Time::HiRes;
   8 use Digest::CRC;
   9
  10 sub serial_settings {{
  11         device    => "/dev/ttyUSB1", # FIXME comment out before shipping
  12         baudrate  => "19200",
  13         databits  => "8",
  14         parity    => "none",
  15         stopbits  => "1",
  16         handshake => "none",
  17 }}
  18
  19 my $port;
  20 sub init {
  21         my $self = shift;
  22         $port = $self->port;
  23
  24         # drain on startup
  25         my ( $count, $str ) = $port->read(3);
  26         my $data = $port->read( ord(substr($str,2,1)) );
  27         warn "drain ",as_hex( $str, $data ),"\n";
  28
  29         setup();
  30
  31 }
  32
  33 sub checksum {
  34         my $bytes = shift;
  35         my $crc = Digest::CRC->new(
  36                 # midified CCITT to xor with 0xffff instead of 0x0000
  37                 width => 16, init => 0xffff, xorout => 0xffff, refout => 0, poly => 0x1021, refin => 0,
  38         ) or die $!;
  39         $crc->add( $bytes );
  40         pack('n', $crc->digest);
  41 }
  42
  43 sub wait_device {
  44         Time::HiRes::sleep 0.015;
  45 }
  46
  47 sub cmd {
  48         my ( $hex, $description, $coderef ) = @_;
  49         my $bytes = hex2bytes($hex);
  50         if ( substr($bytes,0,1) !~ /(\xD5|\xD6)/ ) {
  51                 my $len = pack( 'n', length( $bytes ) + 2 );
  52                 $bytes = $len . $bytes;
  53                 my $checksum = checksum($bytes);
  54                 $bytes = "\xD6" . $bytes . $checksum;
  55         }
  56
  57         warn ">> ", as_hex( $bytes ), "\t\t[$description]\n";
  58         $port->write( $bytes );
  59
  60         wait_device;
  61
  62         my $r_len = $port->read(3);
  63
  64         while ( ! $r_len ) {
  65                 wait_device;
  66                 $r_len = $port->read(3);
  67         }
  68
  69         wait_device;
  70
  71         my $len = ord( substr($r_len,2,1) );
  72         $data = $port->read( $len );
  73         warn "<< ", as_hex($r_len,$data)," $len\n";
  74
  75         $coderef->( $data ) if $coderef;
  76
  77 }
  78
  79 sub assert {
  80         my ( $got, $expected ) = @_;
  81         $expected = hex2bytes($expected);
  82
  83         my $len = length($got);
  84         $len = length($expected) if length $expected < $len;
  85
  86         confess "got ", as_hex($got), " expected ", as_hex($expected)
  87         unless substr($got,0,$len) eq substr($expected,0,$len);
  88
  89         return substr($got,$len);
  90 }
  91
  92 sub setup {
  93
  94 cmd(
  95 'D5 00  05   04 00 11   8C66', 'hw version', sub {
  96         my $data = shift;
  97         my $rest = assert $data => '04 00 11';
  98         my $hw_ver = join('.', unpack('CCCC', $rest));
  99         print "hardware version $hw_ver\n";
 100 });
 101
 102 cmd(
 103 '13  04 01 00 02 00 03 00 04 00','FIXME: stats? rf-on?', sub { assert(shift,
 104 '13  00 02 01 01 03 02 02 03 00'
 105 )});
 106 }
 107
 108 sub inventory {
 109
 110         my $inventory;
 111
 112 cmd( 'FE  00 05', 'scan for tags', sub {
 113         my $data = shift;
 114         my $rest = assert $data => 'FE 00 00 05';
 115         my $nr = ord( substr( $rest, 0, 1 ) );
 116
 117         if ( ! $nr ) {
 118                 warn "# no tags in range\n";
 119         } else {
 120                 my $tags = substr( $rest, 1 );
 121                 my $tl = length( $tags );
 122                 die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
 123
 124                 foreach ( 0 .. $nr - 1 ) {
 125                         my $tag = uc(unpack('H16', substr($tags, $_ * 8, 8)));
 126                         $invetory->{$tag}++;
 127                 }
 128         }
 129
 130 });
 131
 132         return $invetory;
 133 }
 134
 135 1