/[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 22 by dpavlin, Sat Oct 4 11:55:30 2008 UTC
# Line 30  my $response = { Line 30  my $response = {
30  };  };
31    
32  GetOptions(  GetOptions(
33          'd|debug+'      => \$debug,          'd|debug+'    => \$debug,
34          'device=s'    => \$device,          'device=s'    => \$device,
35          'baudrate=i'  => \$baudrate,          'baudrate=i'  => \$baudrate,
36          'databits=i'  => \$databits,          'databits=i'  => \$databits,
# Line 39  GetOptions( Line 39  GetOptions(
39          'handshake=s' => \$handshake,          'handshake=s' => \$handshake,
40  ) or die $!;  ) or die $!;
41    
42    my $verbose = $debug > 0 ? $debug-- : 0;
43    
44  =head1 NAME  =head1 NAME
45    
46  3m-810 - support for 3M 810 RFID reader  3m-810 - support for 3M 810 RFID reader
# Line 70  it under the same terms ans Perl itself. Line 72  it under the same terms ans Perl itself.
72    
73  =cut  =cut
74    
 my $tags_data;  
 my $visible_tags;  
   
75  my $port=new Device::SerialPort($device) || die "can't open serial port $device: $!\n";  my $port=new Device::SerialPort($device) || die "can't open serial port $device: $!\n";
76  warn "using $device $handshake $baudrate $databits $parity $stopbits" if $debug;  warn "using $device $handshake $baudrate $databits $parity $stopbits" if $debug;
77  $handshake=$port->handshake($handshake);  $handshake=$port->handshake($handshake);
# Line 81  $databits=$port->databits($databits); Line 80  $databits=$port->databits($databits);
80  $parity=$port->parity($parity);  $parity=$port->parity($parity);
81  $stopbits=$port->stopbits($stopbits);  $stopbits=$port->stopbits($stopbits);
82    
83  print "## using $device $baudrate $databits $parity $stopbits\n";  print "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n";
84    
85  # Just in case: reset our timing and buffers  # Just in case: reset our timing and buffers
86  $port->lookclear();  $port->lookclear();
# Line 105  cmd( 'D6 00  0C   13  04  01 00  02 00 Line 104  cmd( 'D6 00  0C   13  04  01 00  02 00
104  # start scanning for tags  # start scanning for tags
105    
106  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";  
   
         },  
107           '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
108                  my $rest = shift || die "no rest?";                  my $rest = shift || die "no rest?";
109                  my $nr = ord( substr( $rest, 0, 1 ) );                  my $nr = ord( substr( $rest, 0, 1 ) );
110    
111                  if ( ! $nr ) {                  if ( ! $nr ) {
112                          print "no tags in range\n";                          print "no tags in range\n";
113                            update_visible_tags();
114                  } else {                  } else {
115    
116                          my $tags = substr( $rest, 1 );                          my $tags = substr( $rest, 1 );
# Line 126  cmd( 'D6 00  05   FE     00  05 Line 121  cmd( 'D6 00  05   FE     00  05
121                          my @tags;                          my @tags;
122                          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 );
123                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
124                          print "seen $nr tags: ", join(',', @tags ) , "\n";                          print "$nr tags in range: ", join(',', @tags ) , "\n";
   
                         my $removed_tags = $visible_tags;  
                         $visible_tags = {};  
125    
126                          foreach my $tag ( @tags ) {                          update_visible_tags( @tags );
                                 next if $visible_tags->{$tag}++;  
                                 read_tag( $tag );  
                                 if ( delete $removed_tags->{$tag} ) {  
                                         print "removed tag $tag\n";  
                                 }  
                         }  
127    
128                  }                  }
129          }          }
130  ) foreach ( 1 .. 100 );  ) foreach ( 1 .. 100 );
131    
132    
133    
134    my $tags_data;
135    my $visible_tags;
136    
137    sub update_visible_tags {
138            my @tags = @_;
139    
140            my $last_visible_tags = $visible_tags;
141            $visible_tags = {};
142    
143            foreach my $tag ( @tags ) {
144                    if ( ! defined $last_visible_tags->{$tag} ) {
145                            read_tag( $tag );
146                            $visible_tags->{$tag}++;
147                    } else {
148                            warn "## using cached data for $tag" if $debug;
149                    }
150                    delete $last_visible_tags->{$tag}; # leave just missing tags
151            }
152    
153            foreach my $tag ( keys %$last_visible_tags ) {
154                    print "removed tag $tag with data ",dump( delete $tags_data->{$tag} ),"\n";
155            }
156    
157            warn "## update_visible_tags(",dump( @tags ),") = ",dump( $visible_tags )," removed: ",dump( $last_visible_tags ), " data: ",dump( $tags_data ) if $debug;
158    }
159    
160    
161  sub read_tag {  sub read_tag {
162          my ( $tag ) = @_;          my ( $tag ) = @_;
163    
164            confess "no tag?" unless $tag;
165    
166            return if defined $tags_data->{$tag};
167    
168          print "read_tag $tag\n";          print "read_tag $tag\n";
169    
170          cmd(          cmd(
# Line 320  sub readchunk { Line 339  sub readchunk {
339          my $checksum = substr( $data, -2, 2 );          my $checksum = substr( $data, -2, 2 );
340          checksum( $header . $length . $payload , $checksum );          checksum( $header . $length . $payload , $checksum );
341    
342          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;
343    
344          $assert->{len}      = $len;          $assert->{len}      = $len;
345          $assert->{payload}  = $payload;          $assert->{payload}  = $payload;
# Line 366  sub cmd { Line 385  sub cmd {
385          # fix checksum if needed          # fix checksum if needed
386          $bytes = checksum( substr( $bytes, 0, -2 ), substr( $bytes, -2, 2 ) );          $bytes = checksum( substr( $bytes, 0, -2 ), substr( $bytes, -2, 2 ) );
387    
388          warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n";          warn ">> ", as_hex( $bytes ), "\t## $cmd_desc\n" if $verbose;
389          $assert->{send} = $cmd;          $assert->{send} = $cmd;
390          writechunk( $bytes );          writechunk( $bytes );
391    

Legend:
Removed from v.21  
changed lines
  Added in v.22

  ViewVC Help
Powered by ViewVC 1.1.26