/[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 26 by dpavlin, Wed Apr 1 16:59:09 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                    $meteor_fh = IO::Socket::INET->new( $meteor_server )
22                            || warn "can't connect to meteor $meteor_server: $!"; # FIXME warn => die for production
23                    $meteor_fh = 0; # don't try again
24            }
25    
26            warn ">> meteor ",dump( @a );
27            print $meteor_fh "ADDMESSAGE test ",join('|',@a),"\n" if $meteor_fh;
28    }
29    
30  my $debug = 0;  my $debug = 0;
31    
32  my $device    = "/dev/ttyUSB0";  my $device    = "/dev/ttyUSB0";
# Line 37  GetOptions( Line 56  GetOptions(
56          'parity=s'    => \$parity,          'parity=s'    => \$parity,
57          'stopbits=i'  => \$stopbits,          'stopbits=i'  => \$stopbits,
58          'handshake=s' => \$handshake,          'handshake=s' => \$handshake,
59            'meteor=s'    => \$meteor_server,
60  ) or die $!;  ) or die $!;
61    
62  my $verbose = $debug > 0 ? $debug-- : 0;  my $verbose = $debug > 0 ? $debug-- : 0;
# Line 72  it under the same terms ans Perl itself. Line 92  it under the same terms ans Perl itself.
92    
93  =cut  =cut
94    
95    my $tags_data;
96    my $visible_tags;
97    
98  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";
99  warn "using $device $handshake $baudrate $databits $parity $stopbits" if $debug;  warn "using $device $handshake $baudrate $databits $parity $stopbits" if $debug;
100  $handshake=$port->handshake($handshake);  $handshake=$port->handshake($handshake);
# Line 95  $port->read_char_time(5); Line 118  $port->read_char_time(5);
118    
119  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',  cmd( 'D5 00  05   04 00 11                 8C66', 'hw version',
120       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {       'D5 00  09   04 00 11   0A 05 00 02   7250', sub {
121          print "hardware version ", join('.', unpack('CCCC', skip_assert(3) )), "\n";          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));
122            print "hardware version $hw_ver\n";
123            meteor( 'info', "Found reader hardware $hw_ver" );
124  });  });
125    
126  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 136  cmd( 'D6 00  05   FE     00  05
136                  if ( ! $nr ) {                  if ( ! $nr ) {
137                          print "no tags in range\n";                          print "no tags in range\n";
138                          update_visible_tags();                          update_visible_tags();
139                            meteor( 'info-none-in-range' );
140                            $tags_data = {};
141                  } else {                  } else {
142    
143                          my $tags = substr( $rest, 1 );                          my $tags = substr( $rest, 1 );
# Line 123  cmd( 'D6 00  05   FE     00  05 Line 150  cmd( 'D6 00  05   FE     00  05
150                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                          warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
151                          print "$nr tags in range: ", join(',', @tags ) , "\n";                          print "$nr tags in range: ", join(',', @tags ) , "\n";
152    
153                          update_visible_tags( @tags );                          meteor( 'info-in-range', join(' ',@tags));
154    
155                            update_visible_tags( @tags );
156                  }                  }
157          }          }
158  ) foreach ( 1 .. 100 );  ) while(1);
159    #) foreach ( 1 .. 100 );
160    
161    
162    
 my $tags_data;  
 my $visible_tags;  
   
163  sub update_visible_tags {  sub update_visible_tags {
164          my @tags = @_;          my @tags = @_;
165    
# Line 142  sub update_visible_tags { Line 168  sub update_visible_tags {
168    
169          foreach my $tag ( @tags ) {          foreach my $tag ( @tags ) {
170                  if ( ! defined $last_visible_tags->{$tag} ) {                  if ( ! defined $last_visible_tags->{$tag} ) {
171                          read_tag( $tag );                          if ( defined $tags_data->{$tag} ) {
172    #                               meteor( 'in-range', $tag );
173                            } else {
174                                    meteor( 'read', $tag );
175                                    read_tag( $tag );
176                            }
177                          $visible_tags->{$tag}++;                          $visible_tags->{$tag}++;
178                  } else {                  } else {
179                          warn "## using cached data for $tag" if $debug;                          warn "## using cached data for $tag" if $debug;
# Line 151  sub update_visible_tags { Line 182  sub update_visible_tags {
182          }          }
183    
184          foreach my $tag ( keys %$last_visible_tags ) {          foreach my $tag ( keys %$last_visible_tags ) {
185                  print "removed tag $tag with data ",dump( delete $tags_data->{$tag} ),"\n";                  my $data = delete $tags_data->{$tag};
186                    print "removed tag $tag with data ",dump( $data ),"\n";
187                    meteor( 'removed', $tag );
188          }          }
189    
190          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 196  sub read_tag {
196    
197          confess "no tag?" unless $tag;          confess "no tag?" unless $tag;
198    
         return if defined $tags_data->{$tag};  
   
199          print "read_tag $tag\n";          print "read_tag $tag\n";
200    
201          cmd(          cmd(
Legend:
Removed from v.22  
changed lines
  Added in v.26
  ViewVC Help
Powered by ViewVC 1.1.26