/[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 46 by dpavlin, Tue Jun 23 13:50:13 2009 UTC revision 50 by dpavlin, Wed Jun 24 09:30:28 2009 UTC
# Line 12  use JSON; Line 12  use JSON;
12    
13  use IO::Socket::INET;  use IO::Socket::INET;
14    
15    my $debug = 0;
16    
17  my $meteor_server = '192.168.1.13:4671';  my $meteor_server = '192.168.1.13:4671';
18  my $meteor_fh;  my $meteor_fh;
19    
# Line 78  sub http_server { Line 80  sub http_server {
80                  $client->autoflush(1);                  $client->autoflush(1);
81                  my $request = <$client>;                  my $request = <$client>;
82    
83                  warn "<< $request\n";                  warn "WEB << $request\n" if $debug;
84    
85                  if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {                  if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {
86                          my $method = $1;                          my $method = $1;
# Line 88  sub http_server { Line 90  sub http_server {
90                                          my ($n,$v) = split(/=/, $p, 2);                                          my ($n,$v) = split(/=/, $p, 2);
91                                          $param->{$n} = $v;                                          $param->{$n} = $v;
92                                  }                                  }
93                                  warn "<< param: ",dump( $param );                                  warn "WEB << param: ",dump( $param ) if $debug;
94                          }                          }
95                          if ( my $path = static( $client,$1 ) ) {                          if ( my $path = static( $client,$1 ) ) {
96                                  warn ">> $path";                                  warn "WEB >> $path" if $debug;
97                          } elsif ( $method =~ m{/scan} ) {                          } elsif ( $method =~ m{/scan} ) {
98                                  my $tags = scan_for_tags();                                  my $tags = scan_for_tags();
99                                  my $json = {};                                  my $json = {};
# Line 114  sub http_server { Line 116  sub http_server {
116          die "server died";          die "server died";
117  }  }
118    
119  my $debug = 0;  
120    my $last_message = {};
121    sub _message {
122            my $type = shift @_;
123            my $text = join(' ',@_);
124            my $last = $last_message->{$type};
125            if ( $text ne $last ) {
126                    warn $type eq 'diag' ? '# ' : '', $text, "\n";
127                    $last_message->{$type} = $text;
128            }
129    }
130    
131    sub _log { _message('log',@_) };
132    sub diag { _message('diag',@_) };
133    
134  my $device    = "/dev/ttyUSB0";  my $device    = "/dev/ttyUSB0";
135  my $baudrate  = "19200";  my $baudrate  = "19200";
# Line 218  $databits=$port->databits($databits); Line 233  $databits=$port->databits($databits);
233  $parity=$port->parity($parity);  $parity=$port->parity($parity);
234  $stopbits=$port->stopbits($stopbits);  $stopbits=$port->stopbits($stopbits);
235    
236  print "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n";  warn "## using $device $baudrate $databits $parity $stopbits debug: $debug verbose: $verbose\n";
237    
238  # Just in case: reset our timing and buffers  # Just in case: reset our timing and buffers
239  $port->lookclear();  $port->lookclear();
# Line 245  sub scan_for_tags { Line 260  sub scan_for_tags {
260    
261          my @tags;          my @tags;
262    
263          cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags, retry $_",          cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags",
264                   '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
265                          my $rest = shift || die "no rest?";                          my $rest = shift || die "no rest?";
266                          my $nr = ord( substr( $rest, 0, 1 ) );                          my $nr = ord( substr( $rest, 0, 1 ) );
267    
268                          if ( ! $nr ) {                          if ( ! $nr ) {
269                                  print "no tags in range\n";                                  _log "no tags in range\n";
270                                  update_visible_tags();                                  update_visible_tags();
271                                  meteor( 'info-none-in-range' );                                  meteor( 'info-none-in-range' );
272                                  $tags_data = {};                                  $tags_data = {};
273                          } else {                          } else {
274    
275                                  my $tags = substr( $rest, 1 );                                  my $tags = substr( $rest, 1 );
   
276                                  my $tl = length( $tags );                                  my $tl = length( $tags );
277                                  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;
278    
279                                  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 );
280                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;                                  warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
281                                  print "$nr tags in range: ", join(',', @tags ) , "\n";                                  _log "$nr tags in range: ", join(',', @tags ) , "\n";
282    
283                                  meteor( 'info-in-range', join(' ',@tags));                                  meteor( 'info-in-range', join(' ',@tags));
284    
# Line 273  sub scan_for_tags { Line 287  sub scan_for_tags {
287                  }                  }
288          );          );
289    
290          warn "## tags: ",dump( @tags );          diag "tags: ",dump( @tags );
291          return $tags_data;          return $tags_data;
292    
293  }  }
Legend:
Removed from v.46  
changed lines
  Added in v.50
  ViewVC Help
Powered by ViewVC 1.1.26