/[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 23 by dpavlin, Sat Mar 28 03:47:10 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                  } else {                  } else {
131    
132                          my $tags = substr( $rest, 1 );                          my $tags = substr( $rest, 1 );
# Line 126  cmd( 'D6 00  05   FE     00  05 Line 137  cmd( 'D6 00  05   FE     00  05
137                          my @tags;                          my @tags;
138                          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 );
139                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
140                          print "seen $nr tags: ", join(',', @tags ) , "\n";                          print "$nr tags in range: ", join(',', @tags ) , "\n";
141    
142                            update_visible_tags( @tags );
143    
144                            my $html = join('', map { "<li><tt>$_</tt>" } @tags);
145                            meteor( 0, "Tags:<ul>$html</ul>" );
146                    }
147            }
148    ) foreach ( 1 .. 1000 );
149    
                         my $removed_tags = $visible_tags;  
                         $visible_tags = {};  
150    
                         foreach my $tag ( @tags ) {  
                                 next if $visible_tags->{$tag}++;  
                                 read_tag( $tag );  
                                 if ( delete $removed_tags->{$tag} ) {  
                                         print "removed tag $tag\n";  
                                 }  
                         }  
151    
152    sub update_visible_tags {
153            my @tags = @_;
154    
155            my $last_visible_tags = $visible_tags;
156            $visible_tags = {};
157    
158            foreach my $tag ( @tags ) {
159                    if ( ! defined $last_visible_tags->{$tag} ) {
160                            read_tag( $tag );
161                            $visible_tags->{$tag}++;
162                    } else {
163                            warn "## using cached data for $tag" if $debug;
164                  }                  }
165                    delete $last_visible_tags->{$tag}; # leave just missing tags
166          }          }
167  ) foreach ( 1 .. 100 );  
168            foreach my $tag ( keys %$last_visible_tags ) {
169                    my $data = delete $tags_data->{$tag};
170                    print "removed tag $tag with data ",dump( $data ),"\n";
171            }
172    
173            warn "## update_visible_tags(",dump( @tags ),") = ",dump( $visible_tags )," removed: ",dump( $last_visible_tags ), " data: ",dump( $tags_data ) if $debug;
174    }
175    
176    
177  sub read_tag {  sub read_tag {
178          my ( $tag ) = @_;          my ( $tag ) = @_;
179    
180            confess "no tag?" unless $tag;
181    
182            return if defined $tags_data->{$tag};
183    
184          print "read_tag $tag\n";          print "read_tag $tag\n";
185    
186          cmd(          cmd(
# Line 185  if (0) { Line 220  if (0) {
220  }  }
221          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";
222    
223            my $item = unpack('H*', substr($tag,-8) ) % 100000;
224            meteor( $item, "Loading $item" );
225    
226  }  }
227    
228  exit;  exit;
# Line 320  sub readchunk { Line 358  sub readchunk {
358          my $checksum = substr( $data, -2, 2 );          my $checksum = substr( $data, -2, 2 );
359          checksum( $header . $length . $payload , $checksum );          checksum( $header . $length . $payload , $checksum );
360    
361          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;
362    
363          $assert->{len}      = $len;          $assert->{len}      = $len;
364          $assert->{payload}  = $payload;          $assert->{payload}  = $payload;
# Line 366  sub cmd { Line 404  sub cmd {
404          # fix checksum if needed          # fix checksum if needed
405          $bytes = checksum( substr( $bytes, 0, -2 ), substr( $bytes, -2, 2 ) );          $bytes = checksum( substr( $bytes, 0, -2 ), substr( $bytes, -2, 2 ) );
406    
407          warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n";          warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n" if $verbose;
408          $assert->{send} = $cmd;          $assert->{send} = $cmd;
409          writechunk( $bytes );          writechunk( $bytes );
410    
Legend:
Removed from v.21  
changed lines
  Added in v.23
  ViewVC Help
Powered by ViewVC 1.1.26