/[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 43 by dpavlin, Tue Jun 23 12:19:30 2009 UTC revision 50 by dpavlin, Wed Jun 24 09:30:28 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  use File::Slurp;  use File::Slurp;
11    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 77  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;
87                            my $param;
88                            if ( $method =~ s{\?(.+)}{} ) {
89                                    foreach my $p ( split(/[&;]/, $1) ) {
90                                            my ($n,$v) = split(/=/, $p, 2);
91                                            $param->{$n} = $v;
92                                    }
93                                    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} ) {
                                 print $client "HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\n";  
98                                  my $tags = scan_for_tags();                                  my $tags = scan_for_tags();
99                                  print $client "tags: ",dump($tags);                                  my $json = {};
100                                  my $json;                                  map {
101                                  map { $json->{$_} = decode_tag($_) } keys %$tags;                                          my $d = decode_tag($_);
102                                  print $client "decoded: ",dump( $json );                                          $d->{sid} = $_;
103                                            push @{ $json->{tags} },  $d;
104                                    } keys %$tags;
105                                    print $client "HTTP/1.0 200 OK\r\nContent-Type: application/x-javascript\r\n\r\n",
106                                            $param->{callback}, "(", to_json($json), ")\r\n";
107                          } else {                          } else {
108                                  print $client "HTTP/1.0 404 Unkown method\r\n";                                  print $client "HTTP/1.0 404 Unkown method\r\n";
109                          }                          }
# Line 102  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 142  GetOptions( Line 169  GetOptions(
169          'stopbits=i'  => \$stopbits,          'stopbits=i'  => \$stopbits,
170          'handshake=s' => \$handshake,          'handshake=s' => \$handshake,
171          'meteor=s'    => \$meteor_server,          'meteor=s'    => \$meteor_server,
172            'http-server!' => \$http_server,
173  ) or die $!;  ) or die $!;
174    
175  my $verbose = $debug > 0 ? $debug-- : 0;  my $verbose = $debug > 0 ? $debug-- : 0;
# Line 205  $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 232  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 260  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.43  
changed lines
  Added in v.50
  ViewVC Help
Powered by ViewVC 1.1.26