/[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 25 by dpavlin, Sun Mar 29 01:05:49 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    
15    my $meteor = IO::Socket::INET->new( $meteor_server )
16             || die "can't connect to meteor $meteor_server: $!";
17    
18    sub meteor {
19            my @a = @_;
20            push @a, scalar localtime() if $a[0] =~ m{^info};
21    
22            warn ">> meteor ",dump( @a );
23            print $meteor "ADDMESSAGE test ",join('|',@a),"\n";
24    }
25    
26  my $debug = 0;  my $debug = 0;
27    
28  my $device    = "/dev/ttyUSB0";  my $device    = "/dev/ttyUSB0";
# Line 30  my $response = { Line 45  my $response = {
45  };  };
46    
47  GetOptions(  GetOptions(
48          'd|debug+'      => \$debug,          'd|debug+'    => \$debug,
49          'device=s'    => \$device,          'device=s'    => \$device,
50          'baudrate=i'  => \$baudrate,          'baudrate=i'  => \$baudrate,
51          'databits=i'  => \$databits,          'databits=i'  => \$databits,
# Line 39  GetOptions( Line 54  GetOptions(
54          'handshake=s' => \$handshake,          'handshake=s' => \$handshake,
55  ) or die $!;  ) or die $!;
56    
57    my $verbose = $debug > 0 ? $debug-- : 0;
58    
59  =head1 NAME  =head1 NAME
60    
61  3m-810 - support for 3M 810 RFID reader  3m-810 - support for 3M 810 RFID reader
# Line 81  $databits=$port->databits($databits); Line 98  $databits=$port->databits($databits);
98  $parity=$port->parity($parity);  $parity=$port->parity($parity);
99  $stopbits=$port->stopbits($stopbits);  $stopbits=$port->stopbits($stopbits);
100    
101  print "## using $device $baudrate $databits $parity $stopbits\n";  print "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n";
102    
103  # Just in case: reset our timing and buffers  # Just in case: reset our timing and buffers
104  $port->lookclear();  $port->lookclear();
# Line 96  $port->read_char_time(5); Line 113  $port->read_char_time(5);
113    
114  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',
115       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {
116          print "hardware version ", join('.', unpack('CCCC', skip_assert(3) )), "\n";          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));
117            print "hardware version $hw_ver\n";
118            meteor( 'info', "Found reader hardware $hw_ver" );
119  });  });
120    
121  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 124  cmd( 'D6 00  0C   13  04  01 00  02 00
124  # start scanning for tags  # start scanning for tags
125    
126  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";  
   
         },  
127           '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
128                  my $rest = shift || die "no rest?";                  my $rest = shift || die "no rest?";
129                  my $nr = ord( substr( $rest, 0, 1 ) );                  my $nr = ord( substr( $rest, 0, 1 ) );
130    
131                  if ( ! $nr ) {                  if ( ! $nr ) {
132                          print "no tags in range\n";                          print "no tags in range\n";
133                            update_visible_tags();
134                            meteor( 'info-none-in-range' );
135                            $tags_data = {};
136                  } else {                  } else {
137    
138                          my $tags = substr( $rest, 1 );                          my $tags = substr( $rest, 1 );
# Line 126  cmd( 'D6 00  05   FE     00  05 Line 143  cmd( 'D6 00  05   FE     00  05
143                          my @tags;                          my @tags;
144                          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 );
145                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
146                          print "seen $nr tags: ", join(',', @tags ) , "\n";                          print "$nr tags in range: ", join(',', @tags ) , "\n";
147    
148                            meteor( 'info-in-range', join(' ',@tags));
149    
150                            update_visible_tags( @tags );
151                    }
152            }
153    ) while(1);
154    #) foreach ( 1 .. 100 );
155    
                         my $removed_tags = $visible_tags;  
                         $visible_tags = {};  
156    
157                          foreach my $tag ( @tags ) {  
158                                  next if $visible_tags->{$tag}++;  sub update_visible_tags {
159            my @tags = @_;
160    
161            my $last_visible_tags = $visible_tags;
162            $visible_tags = {};
163    
164            foreach my $tag ( @tags ) {
165                    if ( ! defined $last_visible_tags->{$tag} ) {
166                            if ( defined $tags_data->{$tag} ) {
167    #                               meteor( 'in-range', $tag );
168                            } else {
169                                    meteor( 'read', $tag );
170                                  read_tag( $tag );                                  read_tag( $tag );
                                 if ( delete $removed_tags->{$tag} ) {  
                                         print "removed tag $tag\n";  
                                 }  
171                          }                          }
172                            $visible_tags->{$tag}++;
173                    } else {
174                            warn "## using cached data for $tag" if $debug;
175                  }                  }
176                    delete $last_visible_tags->{$tag}; # leave just missing tags
177          }          }
178  ) foreach ( 1 .. 100 );  
179            foreach my $tag ( keys %$last_visible_tags ) {
180                    my $data = delete $tags_data->{$tag};
181                    print "removed tag $tag with data ",dump( $data ),"\n";
182                    meteor( 'removed', $tag );
183            }
184    
185            warn "## update_visible_tags(",dump( @tags ),") = ",dump( $visible_tags )," removed: ",dump( $last_visible_tags ), " data: ",dump( $tags_data ) if $debug;
186    }
187    
188    
189  sub read_tag {  sub read_tag {
190          my ( $tag ) = @_;          my ( $tag ) = @_;
191    
192            confess "no tag?" unless $tag;
193    
194          print "read_tag $tag\n";          print "read_tag $tag\n";
195    
196          cmd(          cmd(
# Line 320  sub readchunk { Line 365  sub readchunk {
365          my $checksum = substr( $data, -2, 2 );          my $checksum = substr( $data, -2, 2 );
366          checksum( $header . $length . $payload , $checksum );          checksum( $header . $length . $payload , $checksum );
367    
368          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;
369    
370          $assert->{len}      = $len;          $assert->{len}      = $len;
371          $assert->{payload}  = $payload;          $assert->{payload}  = $payload;
# Line 366  sub cmd { Line 411  sub cmd {
411          # fix checksum if needed          # fix checksum if needed
412          $bytes = checksum( substr( $bytes, 0, -2 ), substr( $bytes, -2, 2 ) );          $bytes = checksum( substr( $bytes, 0, -2 ), substr( $bytes, -2, 2 ) );
413    
414          warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n";          warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n" if $verbose;
415          $assert->{send} = $cmd;          $assert->{send} = $cmd;
416          writechunk( $bytes );          writechunk( $bytes );
417    
Legend:
Removed from v.21  
changed lines
  Added in v.25
  ViewVC Help
Powered by ViewVC 1.1.26