/[RFID]/3m-810.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /3m-810.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 21 by dpavlin, Fri Oct 3 21:47:24 2008 UTC revision 27 by dpavlin, Mon Apr 6 11:21:15 2009 UTC
# Line 8  use Data::Dump qw/dump/; Line 8  use Data::Dump qw/dump/;
8  use Carp qw/confess/;  use Carp qw/confess/;
9  use Getopt::Long;  use Getopt::Long;
10    
11    use IO::Socket::INET;
12    
13    my $meteor_server = '192.168.1.13:4671';
14    my $meteor_fh;
15    
16    sub meteor {
17            my @a = @_;
18            push @a, scalar localtime() if $a[0] =~ m{^info};
19    
20            if ( ! defined $meteor_fh ) {
21                    warn "# open connection to $meteor_server";
22                    $meteor_fh = IO::Socket::INET->new(
23                                    PeerAddr => $meteor_server,
24                                    Timeout => 1,
25                    ) || warn "can't connect to meteor $meteor_server: $!"; # FIXME warn => die for production
26                    $meteor_fh = 0; # don't try again
27            }
28    
29            warn ">> meteor ",dump( @a );
30            print $meteor_fh "ADDMESSAGE test ",join('|',@a),"\n" if $meteor_fh;
31    }
32    
33  my $debug = 0;  my $debug = 0;
34    
35  my $device    = "/dev/ttyUSB0";  my $device    = "/dev/ttyUSB0";
# Line 30  my $response = { Line 52  my $response = {
52  };  };
53    
54  GetOptions(  GetOptions(
55          'd|debug+'      => \$debug,          'd|debug+'    => \$debug,
56          'device=s'    => \$device,          'device=s'    => \$device,
57          'baudrate=i'  => \$baudrate,          'baudrate=i'  => \$baudrate,
58          'databits=i'  => \$databits,          'databits=i'  => \$databits,
59          'parity=s'    => \$parity,          'parity=s'    => \$parity,
60          'stopbits=i'  => \$stopbits,          'stopbits=i'  => \$stopbits,
61          'handshake=s' => \$handshake,          'handshake=s' => \$handshake,
62            'meteor=s'    => \$meteor_server,
63  ) or die $!;  ) or die $!;
64    
65    my $verbose = $debug > 0 ? $debug-- : 0;
66    
67  =head1 NAME  =head1 NAME
68    
69  3m-810 - support for 3M 810 RFID reader  3m-810 - support for 3M 810 RFID reader
# Line 81  $databits=$port->databits($databits); Line 106  $databits=$port->databits($databits);
106  $parity=$port->parity($parity);  $parity=$port->parity($parity);
107  $stopbits=$port->stopbits($stopbits);  $stopbits=$port->stopbits($stopbits);
108    
109  print "## using $device $baudrate $databits $parity $stopbits\n";  print "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n";
110    
111  # Just in case: reset our timing and buffers  # Just in case: reset our timing and buffers
112  $port->lookclear();  $port->lookclear();
# Line 96  $port->read_char_time(5); Line 121  $port->read_char_time(5);
121    
122  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',
123       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {
124          print "hardware version ", join('.', unpack('CCCC', skip_assert(3) )), "\n";          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));
125            print "hardware version $hw_ver\n";
126            meteor( 'info', "Found reader hardware $hw_ver" );
127  });  });
128    
129  cmd( 'D6 00  0C   13  04  01 00  02 00  03 00  04 00   AAF2','FIXME: stats?',  cmd( 'D6 00  0C   13  04  01 00  02 00  03 00  04 00   AAF2','FIXME: stats?',
# Line 105  cmd( 'D6 00  0C   13  04  01 00  02 00 Line 132  cmd( 'D6 00  0C   13  04  01 00  02 00
132  # start scanning for tags  # start scanning for tags
133    
134  cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags, retry $_",  cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags, retry $_",
      'D6 00  07   FE  00 00  05     00  C97B', sub {  
                 assert();  
                 print "no tag in range\n";  
   
         },  
135           'D6 00  0F   FE  00 00  05 ', sub { # 01 E00401003123AA26  941A         # seen, serial length: 8           'D6 00  0F   FE  00 00  05 ', sub { # 01 E00401003123AA26  941A         # seen, serial length: 8
136                  my $rest = shift || die "no rest?";                  my $rest = shift || die "no rest?";
137                  my $nr = ord( substr( $rest, 0, 1 ) );                  my $nr = ord( substr( $rest, 0, 1 ) );
138    
139                  if ( ! $nr ) {                  if ( ! $nr ) {
140                          print "no tags in range\n";                          print "no tags in range\n";
141                            update_visible_tags();
142                            meteor( 'info-none-in-range' );
143                            $tags_data = {};
144                  } else {                  } else {
145    
146                          my $tags = substr( $rest, 1 );                          my $tags = substr( $rest, 1 );
# Line 126  cmd( 'D6 00  05   FE     00  05 Line 151  cmd( 'D6 00  05   FE     00  05
151                          my @tags;                          my @tags;
152                          push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 );                          push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 );
153                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
154                          print "seen $nr tags: ", join(',', @tags ) , "\n";                          print "$nr tags in range: ", join(',', @tags ) , "\n";
155    
156                            meteor( 'info-in-range', join(' ',@tags));
157    
158                            update_visible_tags( @tags );
159                    }
160            }
161    ) while(1);
162    #) foreach ( 1 .. 100 );
163    
                         my $removed_tags = $visible_tags;  
                         $visible_tags = {};  
164    
165                          foreach my $tag ( @tags ) {  
166                                  next if $visible_tags->{$tag}++;  sub update_visible_tags {
167            my @tags = @_;
168    
169            my $last_visible_tags = $visible_tags;
170            $visible_tags = {};
171    
172            foreach my $tag ( @tags ) {
173                    if ( ! defined $last_visible_tags->{$tag} ) {
174                            if ( defined $tags_data->{$tag} ) {
175    #                               meteor( 'in-range', $tag );
176                            } else {
177                                    meteor( 'read', $tag );
178                                  read_tag( $tag );                                  read_tag( $tag );
                                 if ( delete $removed_tags->{$tag} ) {  
                                         print "removed tag $tag\n";  
                                 }  
179                          }                          }
180                            $visible_tags->{$tag}++;
181                    } else {
182                            warn "## using cached data for $tag" if $debug;
183                  }                  }
184                    delete $last_visible_tags->{$tag}; # leave just missing tags
185          }          }
186  ) foreach ( 1 .. 100 );  
187            foreach my $tag ( keys %$last_visible_tags ) {
188                    my $data = delete $tags_data->{$tag};
189                    print "removed tag $tag with data ",dump( $data ),"\n";
190                    meteor( 'removed', $tag );
191            }
192    
193            warn "## update_visible_tags(",dump( @tags ),") = ",dump( $visible_tags )," removed: ",dump( $last_visible_tags ), " data: ",dump( $tags_data ) if $debug;
194    }
195    
196    
197  sub read_tag {  sub read_tag {
198          my ( $tag ) = @_;          my ( $tag ) = @_;
199    
200            confess "no tag?" unless $tag;
201    
202          print "read_tag $tag\n";          print "read_tag $tag\n";
203    
204          cmd(          cmd(
# Line 320  sub readchunk { Line 373  sub readchunk {
373          my $checksum = substr( $data, -2, 2 );          my $checksum = substr( $data, -2, 2 );
374          checksum( $header . $length . $payload , $checksum );          checksum( $header . $length . $payload , $checksum );
375    
376          print "<< ",as_hex( $header ), " [$len] ", as_hex( $payload ), " | sum: ",as_hex($checksum),"\n";          print "<< ",as_hex( $header ), " [$len] ", as_hex( $payload ), " | sum: ",as_hex($checksum),"\n" if $verbose;
377    
378          $assert->{len}      = $len;          $assert->{len}      = $len;
379          $assert->{payload}  = $payload;          $assert->{payload}  = $payload;
# Line 366  sub cmd { Line 419  sub cmd {
419          # fix checksum if needed          # fix checksum if needed
420          $bytes = checksum( substr( $bytes, 0, -2 ), substr( $bytes, -2, 2 ) );          $bytes = checksum( substr( $bytes, 0, -2 ), substr( $bytes, -2, 2 ) );
421    
422          warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n";          warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n" if $verbose;
423          $assert->{send} = $cmd;          $assert->{send} = $cmd;
424          writechunk( $bytes );          writechunk( $bytes );
425    
Legend:
Removed from v.21  
changed lines
  Added in v.27
  ViewVC Help
Powered by ViewVC 1.1.26