/[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 22 by dpavlin, Sat Oct 4 11:55:30 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 72  it under the same terms ans Perl itself. Line 87  it under the same terms ans Perl itself.
87    
88  =cut  =cut
89    
90    my $tags_data;
91    my $visible_tags;
92    
93  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";
94  warn "using $device $handshake $baudrate $databits $parity $stopbits" if $debug;  warn "using $device $handshake $baudrate $databits $parity $stopbits" if $debug;
95  $handshake=$port->handshake($handshake);  $handshake=$port->handshake($handshake);
# Line 95  $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 111  cmd( 'D6 00  05   FE     00  05 Line 131  cmd( 'D6 00  05   FE     00  05
131                  if ( ! $nr ) {                  if ( ! $nr ) {
132                          print "no tags in range\n";                          print "no tags in range\n";
133                          update_visible_tags();                          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 123  cmd( 'D6 00  05   FE     00  05 Line 145  cmd( 'D6 00  05   FE     00  05
145                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
146                          print "$nr tags in range: ", join(',', @tags ) , "\n";                          print "$nr tags in range: ", join(',', @tags ) , "\n";
147    
148                          update_visible_tags( @tags );                          meteor( 'info-in-range', join(' ',@tags));
149    
150                            update_visible_tags( @tags );
151                  }                  }
152          }          }
153  ) foreach ( 1 .. 100 );  ) while(1);
154    #) foreach ( 1 .. 100 );
155    
156    
157    
 my $tags_data;  
 my $visible_tags;  
   
158  sub update_visible_tags {  sub update_visible_tags {
159          my @tags = @_;          my @tags = @_;
160    
# Line 142  sub update_visible_tags { Line 163  sub update_visible_tags {
163    
164          foreach my $tag ( @tags ) {          foreach my $tag ( @tags ) {
165                  if ( ! defined $last_visible_tags->{$tag} ) {                  if ( ! defined $last_visible_tags->{$tag} ) {
166                          read_tag( $tag );                          if ( defined $tags_data->{$tag} ) {
167    #                               meteor( 'in-range', $tag );
168                            } else {
169                                    meteor( 'read', $tag );
170                                    read_tag( $tag );
171                            }
172                          $visible_tags->{$tag}++;                          $visible_tags->{$tag}++;
173                  } else {                  } else {
174                          warn "## using cached data for $tag" if $debug;                          warn "## using cached data for $tag" if $debug;
# Line 151  sub update_visible_tags { Line 177  sub update_visible_tags {
177          }          }
178    
179          foreach my $tag ( keys %$last_visible_tags ) {          foreach my $tag ( keys %$last_visible_tags ) {
180                  print "removed tag $tag with data ",dump( delete $tags_data->{$tag} ),"\n";                  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;          warn "## update_visible_tags(",dump( @tags ),") = ",dump( $visible_tags )," removed: ",dump( $last_visible_tags ), " data: ",dump( $tags_data ) if $debug;
# Line 163  sub read_tag { Line 191  sub read_tag {
191    
192          confess "no tag?" unless $tag;          confess "no tag?" unless $tag;
193    
         return if defined $tags_data->{$tag};  
   
194          print "read_tag $tag\n";          print "read_tag $tag\n";
195    
196          cmd(          cmd(
Legend:
Removed from v.22  
changed lines
  Added in v.25
  ViewVC Help
Powered by ViewVC 1.1.26