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
   9 sub serial_settings {{
  10         device    => "/dev/ttyUSB1", # FIXME comment out before shipping
  11         baudrate  => "19200",
  12         databits  => "8",
  13         parity    => "none",
  14         stopbits  => "1",
  15         handshake => "none",
  16 }}
  17
  18 my $port;
  19 sub init {
  20         my $self = shift;
  21         $port = $self->port;
  22
  23         # drain on startup
  24         my ( $count, $str ) = $port->read(3);
  25         my $data = $port->read( ord(substr($str,2,1)) );
  26         warn "drain ",as_hex( $str, $data ),"\n";
  27
  28         setup();
  29
  30 }
  31
  32 sub wait_device {
  33         Time::HiRes::sleep 0.015;
  34 }
  35
  36 sub cmd {
  37         my ( $hex, $description, $coderef ) = @_;
  38         my $bytes = hex2bytes($hex);
  39         if ( substr($bytes,0,1) !~ /(\xD5|\xD6)/ ) {
  40                 my $len = pack( 'c', length( $bytes ) + 3 );
  41                 $bytes = $len . $bytes;
  42                 my $checksum = checksum($bytes);
  43                 $bytes = "\xD6\x00" . $bytes . $checksum;
  44         }
  45
  46         warn ">> ", as_hex( $bytes ), "\t\t[$description]\n";
  47         $port->write( $bytes );
  48
  49         wait_device;
  50
  51         my $r_len = $port->read(3);
  52
  53         while ( ! $r_len ) {
  54                 wait_device;
  55                 $r_len = $port->read(3);
  56         }
  57
  58         my $len = ord( substr($r_len,2,1) );
  59         $data = $port->read( $len );
  60         warn "<< ", as_hex($r_len,$data)," $len\n";
  61
  62         $coderef->( $data ) if $coderef;
  63
  64 }
  65
  66 sub assert {
  67         my ( $got, $expected ) = @_;
  68         $expected = hex2bytes($expected);
  69
  70         my $len = length($got);
  71         $len = length($expected) if length $expected < $len;
  72
  73         confess "got ", as_hex($got), " expected ", as_hex($expected)
  74         unless substr($got,0,$len) eq substr($expected,0,$len);
  75 }
  76
  77 sub setup {
  78
  79 cmd(
  80 'D5 00  05   04 00 11   8C66', 'hw version', sub {
  81         my $data = shift;
  82         assert $data => '04 00 11';
  83         my $hw_ver = join('.', unpack('CCCC', substr($data,3)));
  84         print "hardware version $hw_ver\n";
  85 });
  86
  87 cmd(
  88 'D6 00  0C   13  04  01 00  02 00  03 00  04 00   AAF2','FIXME: stats?', sub { assert(shift,
  89 '            13  00  02 01 01 03 02 02 03  00     E778'
  90 )});
  91
  92 }
  93
  94 1