/[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 23 by dpavlin, Sat Mar 28 03:47:10 2009 UTC revision 26 by dpavlin, Wed Apr 1 16:59:09 2009 UTC
# Line 10  use Getopt::Long; Line 10  use Getopt::Long;
10    
11  use IO::Socket::INET;  use IO::Socket::INET;
12    
13  my $meteor = IO::Socket::INET->new( '192.168.1.13:4671' ) || die "can't connect to meteor: $!";  my $meteor_server = '192.168.1.13:4671';
14    my $meteor_fh;
15    
16  sub meteor {  sub meteor {
17          my ( $item, $html ) = @_;          my @a = @_;
18          warn ">> meteor $item $html\n";          push @a, scalar localtime() if $a[0] =~ m{^info};
19          print $meteor "ADDMESSAGE test $item|" . localtime() . "<br>$html\n";  
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;
# Line 47  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 110  cmd( 'D5 00  05   04 00 11 Line 120  cmd( 'D5 00  05   04 00 11
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          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));          my $hw_ver = join('.', unpack('CCCC', skip_assert(3) ));
122          print "hardware version $hw_ver\n";          print "hardware version $hw_ver\n";
123          meteor( -1, "Found reader $hw_ver" );          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 126  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( -1, "No tags in range" );                          meteor( 'info-none-in-range' );
140                            $tags_data = {};
141                  } else {                  } else {
142    
143                          my $tags = substr( $rest, 1 );                          my $tags = substr( $rest, 1 );
# Line 139  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                          my $html = join('', map { "<li><tt>$_</tt>" } @tags);                          update_visible_tags( @tags );
                         meteor( 0, "Tags:<ul>$html</ul>" );  
156                  }                  }
157          }          }
158  ) foreach ( 1 .. 1000 );  ) while(1);
159    #) foreach ( 1 .. 100 );
160    
161    
162    
# Line 157  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 168  sub update_visible_tags { Line 184  sub update_visible_tags {
184          foreach my $tag ( keys %$last_visible_tags ) {          foreach my $tag ( keys %$last_visible_tags ) {
185                  my $data = delete $tags_data->{$tag};                  my $data = delete $tags_data->{$tag};
186                  print "removed tag $tag with data ",dump( $data ),"\n";                  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 179  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(
# Line 220  if (0) { Line 235  if (0) {
235  }  }
236          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";
237    
         my $item = unpack('H*', substr($tag,-8) ) % 100000;  
         meteor( $item, "Loading $item" );  
   
238  }  }
239    
240  exit;  exit;
Legend:
Removed from v.23  
changed lines
  Added in v.26
  ViewVC Help
Powered by ViewVC 1.1.26