/[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 27 by dpavlin, Mon Apr 6 11:21:15 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    my $meteor_fh;
15    
16    sub meteor {
17            my @a = @_;
18            push @a, scalar localtime() if $a[0] =~ m{^info};
19    
20            if ( ! defined $meteor_fh ) {
21                    warn "# open connection to $meteor_server";
22                    $meteor_fh = IO::Socket::INET->new(
23                                    PeerAddr => $meteor_server,
24                                    Timeout => 1,
25                    ) || warn "can't connect to meteor $meteor_server: $!"; # FIXME warn => die for production
26                    $meteor_fh = 0; # don't try again
27            }
28    
29            warn ">> meteor ",dump( @a );
30            print $meteor_fh "ADDMESSAGE test ",join('|',@a),"\n" if $meteor_fh;
31    }
32    
33  my $debug = 0;  my $debug = 0;
34    
35  my $device    = "/dev/ttyUSB0";  my $device    = "/dev/ttyUSB0";
# Line 37  GetOptions( Line 59  GetOptions(
59          'parity=s'    => \$parity,          'parity=s'    => \$parity,
60          'stopbits=i'  => \$stopbits,          'stopbits=i'  => \$stopbits,
61          'handshake=s' => \$handshake,          'handshake=s' => \$handshake,
62            'meteor=s'    => \$meteor_server,
63  ) or die $!;  ) or die $!;
64    
65  my $verbose = $debug > 0 ? $debug-- : 0;  my $verbose = $debug > 0 ? $debug-- : 0;
# Line 72  it under the same terms ans Perl itself. Line 95  it under the same terms ans Perl itself.
95    
96  =cut  =cut
97    
98    my $tags_data;
99    my $visible_tags;
100    
101  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";
102  warn "using $device $handshake $baudrate $databits $parity $stopbits" if $debug;  warn "using $device $handshake $baudrate $databits $parity $stopbits" if $debug;
103  $handshake=$port->handshake($handshake);  $handshake=$port->handshake($handshake);
# Line 95  $port->read_char_time(5); Line 121  $port->read_char_time(5);
121    
122  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',
123       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {
124          print "hardware version ", join('.', unpack('CCCC', skip_assert(3) )), "\n";          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));
125            print "hardware version $hw_ver\n";
126            meteor( 'info', "Found reader hardware $hw_ver" );
127  });  });
128    
129  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 139  cmd( 'D6 00  05   FE     00  05
139                  if ( ! $nr ) {                  if ( ! $nr ) {
140                          print "no tags in range\n";                          print "no tags in range\n";
141                          update_visible_tags();                          update_visible_tags();
142                            meteor( 'info-none-in-range' );
143                            $tags_data = {};
144                  } else {                  } else {
145    
146                          my $tags = substr( $rest, 1 );                          my $tags = substr( $rest, 1 );
# Line 123  cmd( 'D6 00  05   FE     00  05 Line 153  cmd( 'D6 00  05   FE     00  05
153                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
154                          print "$nr tags in range: ", join(',', @tags ) , "\n";                          print "$nr tags in range: ", join(',', @tags ) , "\n";
155    
156                          update_visible_tags( @tags );                          meteor( 'info-in-range', join(' ',@tags));
157    
158                            update_visible_tags( @tags );
159                  }                  }
160          }          }
161  ) foreach ( 1 .. 100 );  ) while(1);
162    #) foreach ( 1 .. 100 );
163    
164    
165    
 my $tags_data;  
 my $visible_tags;  
   
166  sub update_visible_tags {  sub update_visible_tags {
167          my @tags = @_;          my @tags = @_;
168    
# Line 142  sub update_visible_tags { Line 171  sub update_visible_tags {
171    
172          foreach my $tag ( @tags ) {          foreach my $tag ( @tags ) {
173                  if ( ! defined $last_visible_tags->{$tag} ) {                  if ( ! defined $last_visible_tags->{$tag} ) {
174                          read_tag( $tag );                          if ( defined $tags_data->{$tag} ) {
175    #                               meteor( 'in-range', $tag );
176                            } else {
177                                    meteor( 'read', $tag );
178                                    read_tag( $tag );
179                            }
180                          $visible_tags->{$tag}++;                          $visible_tags->{$tag}++;
181                  } else {                  } else {
182                          warn "## using cached data for $tag" if $debug;                          warn "## using cached data for $tag" if $debug;
# Line 151  sub update_visible_tags { Line 185  sub update_visible_tags {
185          }          }
186    
187          foreach my $tag ( keys %$last_visible_tags ) {          foreach my $tag ( keys %$last_visible_tags ) {
188                  print "removed tag $tag with data ",dump( delete $tags_data->{$tag} ),"\n";                  my $data = delete $tags_data->{$tag};
189                    print "removed tag $tag with data ",dump( $data ),"\n";
190                    meteor( 'removed', $tag );
191          }          }
192    
193          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 199  sub read_tag {
199    
200          confess "no tag?" unless $tag;          confess "no tag?" unless $tag;
201    
         return if defined $tags_data->{$tag};  
   
202          print "read_tag $tag\n";          print "read_tag $tag\n";
203    
204          cmd(          cmd(
Legend:
Removed from v.22  
changed lines
  Added in v.27
  ViewVC Help
Powered by ViewVC 1.1.26