/[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 24 by dpavlin, Sat Mar 28 14:20:27 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 = IO::Socket::INET->new( '192.168.1.13:4671' ) || die "can't connect to meteor: $!";
14    
15    sub meteor {
16            my ( $item, $html ) = @_;
17            warn ">> meteor $item $html\n";
18            print $meteor "ADDMESSAGE test $item|" . localtime() . "<br>$html\n";
19    }
20    
21  my $debug = 0;  my $debug = 0;
22    
23  my $device    = "/dev/ttyUSB0";  my $device    = "/dev/ttyUSB0";
# Line 30  my $response = { Line 40  my $response = {
40  };  };
41    
42  GetOptions(  GetOptions(
43          'd|debug+'      => \$debug,          'd|debug+'    => \$debug,
44          'device=s'    => \$device,          'device=s'    => \$device,
45          'baudrate=i'  => \$baudrate,          'baudrate=i'  => \$baudrate,
46          'databits=i'  => \$databits,          'databits=i'  => \$databits,
# Line 39  GetOptions( Line 49  GetOptions(
49          'handshake=s' => \$handshake,          'handshake=s' => \$handshake,
50  ) or die $!;  ) or die $!;
51    
52    my $verbose = $debug > 0 ? $debug-- : 0;
53    
54  =head1 NAME  =head1 NAME
55    
56  3m-810 - support for 3M 810 RFID reader  3m-810 - support for 3M 810 RFID reader
# Line 81  $databits=$port->databits($databits); Line 93  $databits=$port->databits($databits);
93  $parity=$port->parity($parity);  $parity=$port->parity($parity);
94  $stopbits=$port->stopbits($stopbits);  $stopbits=$port->stopbits($stopbits);
95    
96  print "## using $device $baudrate $databits $parity $stopbits\n";  print "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n";
97    
98  # Just in case: reset our timing and buffers  # Just in case: reset our timing and buffers
99  $port->lookclear();  $port->lookclear();
# Line 96  $port->read_char_time(5); Line 108  $port->read_char_time(5);
108    
109  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',
110       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {
111          print "hardware version ", join('.', unpack('CCCC', skip_assert(3) )), "\n";          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));
112            print "hardware version $hw_ver\n";
113            meteor( -1, "Found reader $hw_ver" );
114  });  });
115    
116  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 119  cmd( 'D6 00  0C   13  04  01 00  02 00
119  # start scanning for tags  # start scanning for tags
120    
121  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";  
   
         },  
122           '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
123                  my $rest = shift || die "no rest?";                  my $rest = shift || die "no rest?";
124                  my $nr = ord( substr( $rest, 0, 1 ) );                  my $nr = ord( substr( $rest, 0, 1 ) );
125    
126                  if ( ! $nr ) {                  if ( ! $nr ) {
127                          print "no tags in range\n";                          print "no tags in range\n";
128                            update_visible_tags();
129                            meteor( -1, "No tags in range" );
130                            $tags_data = {};
131                  } else {                  } else {
132    
133                          my $tags = substr( $rest, 1 );                          my $tags = substr( $rest, 1 );
# Line 126  cmd( 'D6 00  05   FE     00  05 Line 138  cmd( 'D6 00  05   FE     00  05
138                          my @tags;                          my @tags;
139                          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 );
140                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
141                          print "seen $nr tags: ", join(',', @tags ) , "\n";                          print "$nr tags in range: ", join(',', @tags ) , "\n";
142    
143                            update_visible_tags( @tags );
144    
145                            my $html = join('', map { "<li><tt>$_</tt>" } @tags);
146                            meteor( 0, "Tags:<ul>$html</ul>" );
147                    }
148            }
149    ) while(1);
150    #) foreach ( 1 .. 100 );
151    
                         my $removed_tags = $visible_tags;  
                         $visible_tags = {};  
152    
                         foreach my $tag ( @tags ) {  
                                 next if $visible_tags->{$tag}++;  
                                 read_tag( $tag );  
                                 if ( delete $removed_tags->{$tag} ) {  
                                         print "removed tag $tag\n";  
                                 }  
                         }  
153    
154    sub update_visible_tags {
155            my @tags = @_;
156    
157            my $last_visible_tags = $visible_tags;
158            $visible_tags = {};
159    
160            foreach my $tag ( @tags ) {
161                    if ( ! defined $last_visible_tags->{$tag} ) {
162                            read_tag( $tag );
163                            $visible_tags->{$tag}++;
164                    } else {
165                            warn "## using cached data for $tag" if $debug;
166                  }                  }
167                    delete $last_visible_tags->{$tag}; # leave just missing tags
168          }          }
169  ) foreach ( 1 .. 100 );  
170            foreach my $tag ( keys %$last_visible_tags ) {
171                    my $data = delete $tags_data->{$tag};
172                    print "removed tag $tag with data ",dump( $data ),"\n";
173            }
174    
175            warn "## update_visible_tags(",dump( @tags ),") = ",dump( $visible_tags )," removed: ",dump( $last_visible_tags ), " data: ",dump( $tags_data ) if $debug;
176    }
177    
178    
179  sub read_tag {  sub read_tag {
180          my ( $tag ) = @_;          my ( $tag ) = @_;
181    
182            confess "no tag?" unless $tag;
183    
184            return if defined $tags_data->{$tag};
185    
186          print "read_tag $tag\n";          print "read_tag $tag\n";
187    
188          cmd(          cmd(
# Line 185  if (0) { Line 222  if (0) {
222  }  }
223          warn "?? D6 00  0F  FE  00 00  05 01   $tag  941A ##### ready?\n";          warn "?? D6 00  0F  FE  00 00  05 01   $tag  941A ##### ready?\n";
224    
225            my $item = unpack('H*', substr($tag,-8) ) % 100000;
226            meteor( $item, "Loading $item" );
227    
228  }  }
229    
230  exit;  exit;
# Line 320  sub readchunk { Line 360  sub readchunk {
360          my $checksum = substr( $data, -2, 2 );          my $checksum = substr( $data, -2, 2 );
361          checksum( $header . $length . $payload , $checksum );          checksum( $header . $length . $payload , $checksum );
362    
363          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;
364    
365          $assert->{len}      = $len;          $assert->{len}      = $len;
366          $assert->{payload}  = $payload;          $assert->{payload}  = $payload;
# Line 366  sub cmd { Line 406  sub cmd {
406          # fix checksum if needed          # fix checksum if needed
407          $bytes = checksum( substr( $bytes, 0, -2 ), substr( $bytes, -2, 2 ) );          $bytes = checksum( substr( $bytes, 0, -2 ), substr( $bytes, -2, 2 ) );
408    
409          warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n";          warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n" if $verbose;
410          $assert->{send} = $cmd;          $assert->{send} = $cmd;
411          writechunk( $bytes );          writechunk( $bytes );
412    
Legend:
Removed from v.21  
changed lines
  Added in v.24
  ViewVC Help
Powered by ViewVC 1.1.26