/[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 45 by dpavlin, Tue Jun 23 13:29:10 2009 UTC revision 54 by dpavlin, Wed Jun 24 13:39:43 2009 UTC
# Line 12  use JSON; Line 12  use JSON;
12    
13  use IO::Socket::INET;  use IO::Socket::INET;
14    
15  my $meteor_server = '192.168.1.13:4671';  my $debug = 0;
16    
17    my $tags_data;
18    my $tags_security;
19    my $visible_tags;
20    
21    my $meteor_server; # = '192.168.1.13:4671';
22  my $meteor_fh;  my $meteor_fh;
23    
24  sub meteor {  sub meteor {
# Line 78  sub http_server { Line 84  sub http_server {
84                  $client->autoflush(1);                  $client->autoflush(1);
85                  my $request = <$client>;                  my $request = <$client>;
86    
87                  warn "<< $request\n";                  warn "WEB << $request\n" if $debug;
88    
89                  if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {                  if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {
90                          my $method = $1;                          my $method = $1;
91                            my $param;
92                            if ( $method =~ s{\?(.+)}{} ) {
93                                    foreach my $p ( split(/[&;]/, $1) ) {
94                                            my ($n,$v) = split(/=/, $p, 2);
95                                            $param->{$n} = $v;
96                                    }
97                                    warn "WEB << param: ",dump( $param ) if $debug;
98                            }
99                          if ( my $path = static( $client,$1 ) ) {                          if ( my $path = static( $client,$1 ) ) {
100                                  warn ">> $path";                                  warn "WEB >> $path" if $debug;
101                          } elsif ( $method =~ m{/scan} ) {                          } elsif ( $method =~ m{/scan} ) {
                                 my $callback = $1 if $method =~ m{\?callback=([^&;]+)};  
102                                  my $tags = scan_for_tags();                                  my $tags = scan_for_tags();
103                                  my $json;                                  my $json = { time => time() };
104                                  map {                                  map {
105                                          my $d = decode_tag($_);                                          my $d = decode_tag($_);
106                                          $d->{sid} = $_;                                          $d->{sid} = $_;
107                                            $d->{security} = $tags_security->{$_};
108                                          push @{ $json->{tags} },  $d;                                          push @{ $json->{tags} },  $d;
109                                  } keys %$tags;                                  } keys %$tags;
110                                  print $client "HTTP/1.0 200 OK\r\nContent-Type: application/x-javascript\r\n\r\n$callback(", to_json($json), ")\r\n";                                  print $client "HTTP/1.0 200 OK\r\nContent-Type: application/x-javascript\r\n\r\n",
111                                            $param->{callback}, "(", to_json($json), ")\r\n";
112                          } else {                          } else {
113                                  print $client "HTTP/1.0 404 Unkown method\r\n";                                  print $client "HTTP/1.0 404 Unkown method\r\n";
114                          }                          }
# Line 106  sub http_server { Line 121  sub http_server {
121          die "server died";          die "server died";
122  }  }
123    
124  my $debug = 0;  
125    my $last_message = {};
126    sub _message {
127            my $type = shift @_;
128            my $text = join(' ',@_);
129            my $last = $last_message->{$type};
130            if ( $text ne $last ) {
131                    warn $type eq 'diag' ? '# ' : '', $text, "\n";
132                    $last_message->{$type} = $text;
133            }
134    }
135    
136    sub _log { _message('log',@_) };
137    sub diag { _message('diag',@_) };
138    
139  my $device    = "/dev/ttyUSB0";  my $device    = "/dev/ttyUSB0";
140  my $baudrate  = "19200";  my $baudrate  = "19200";
# Line 182  it under the same terms ans Perl itself. Line 210  it under the same terms ans Perl itself.
210    
211  =cut  =cut
212    
 my $tags_data;  
 my $visible_tags;  
   
213  my $item_type = {  my $item_type = {
214          1 => 'Book',          1 => 'Book',
215          6 => 'CD/CD ROM',          6 => 'CD/CD ROM',
# Line 210  $databits=$port->databits($databits); Line 235  $databits=$port->databits($databits);
235  $parity=$port->parity($parity);  $parity=$port->parity($parity);
236  $stopbits=$port->stopbits($stopbits);  $stopbits=$port->stopbits($stopbits);
237    
238  print "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n";  warn "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n";
239    
240  # Just in case: reset our timing and buffers  # Just in case: reset our timing and buffers
241  $port->lookclear();  $port->lookclear();
# Line 237  sub scan_for_tags { Line 262  sub scan_for_tags {
262    
263          my @tags;          my @tags;
264    
265          cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags, retry $_",          cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags",
266                   '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
267                          my $rest = shift || die "no rest?";                          my $rest = shift || die "no rest?";
268                          my $nr = ord( substr( $rest, 0, 1 ) );                          my $nr = ord( substr( $rest, 0, 1 ) );
269    
270                          if ( ! $nr ) {                          if ( ! $nr ) {
271                                  print "no tags in range\n";                                  _log "no tags in range\n";
272                                  update_visible_tags();                                  update_visible_tags();
273                                  meteor( 'info-none-in-range' );                                  meteor( 'info-none-in-range' );
274                                  $tags_data = {};                                  $tags_data = {};
275                          } else {                          } else {
276    
277                                  my $tags = substr( $rest, 1 );                                  my $tags = substr( $rest, 1 );
   
278                                  my $tl = length( $tags );                                  my $tl = length( $tags );
279                                  die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;                                  die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
280    
281                                  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 );
282                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
283                                  print "$nr tags in range: ", join(',', @tags ) , "\n";                                  _log "$nr tags in range: ", join(',', @tags ) , "\n";
284    
285                                  meteor( 'info-in-range', join(' ',@tags));                                  meteor( 'info-in-range', join(' ',@tags));
286    
# Line 265  sub scan_for_tags { Line 289  sub scan_for_tags {
289                  }                  }
290          );          );
291    
292          warn "## tags: ",dump( @tags );          diag "tags: ",dump( @tags );
293          return $tags_data;          return $tags_data;
294    
295  }  }
# Line 287  sub update_visible_tags { Line 311  sub update_visible_tags {
311          $visible_tags = {};          $visible_tags = {};
312    
313          foreach my $tag ( @tags ) {          foreach my $tag ( @tags ) {
314                    $visible_tags->{$tag}++;
315                  if ( ! defined $last_visible_tags->{$tag} ) {                  if ( ! defined $last_visible_tags->{$tag} ) {
316                          if ( defined $tags_data->{$tag} ) {                          if ( defined $tags_data->{$tag} ) {
317  #                               meteor( 'in-range', $tag );  #                               meteor( 'in-range', $tag );
# Line 294  sub update_visible_tags { Line 319  sub update_visible_tags {
319                                  meteor( 'read', $tag );                                  meteor( 'read', $tag );
320                                  read_tag( $tag );                                  read_tag( $tag );
321                          }                          }
                         $visible_tags->{$tag}++;  
322                  } else {                  } else {
323                          warn "## using cached data for $tag" if $debug;                          warn "## using cached data for $tag" if $debug;
324                  }                  }
# Line 410  sub read_tag { Line 434  sub read_tag {
434                          ( $from_tag, $security ) = ( substr($rest,0,8), substr($rest,8,1) );                          ( $from_tag, $security ) = ( substr($rest,0,8), substr($rest,8,1) );
435                          die "security from other tag: ",as_hex( $from_tag ) if $from_tag ne str2bytes( $tag );                          die "security from other tag: ",as_hex( $from_tag ) if $from_tag ne str2bytes( $tag );
436                          $security = as_hex( $security );                          $security = as_hex( $security );
437                            $tags_security->{$tag} = $security;
438                          warn "# SECURITY $tag = $security\n";                          warn "# SECURITY $tag = $security\n";
439                  }                  }
440          );          );
# Line 635  sub readchunk { Line 660  sub readchunk {
660                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;                  warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;
661                  $dispatch->{ $to }->( $rest );                  $dispatch->{ $to }->( $rest );
662          } else {          } else {
663                  print "NO DISPATCH for ",dump( $full ),"\n";                  print "NO DISPATCH for ",as_hex( $full ),"\n";
664          }          }
665    
666          return $data;          return $data;
Legend:
Removed from v.45  
changed lines
  Added in v.54
  ViewVC Help
Powered by ViewVC 1.1.26