/[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 44 by dpavlin, Tue Jun 23 13:10:18 2009 UTC revision 48 by dpavlin, Tue Jun 23 14:59:53 2009 UTC
# Line 82  sub http_server { Line 82  sub http_server {
82    
83                  if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {                  if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {
84                          my $method = $1;                          my $method = $1;
85                            my $param;
86                            if ( $method =~ s{\?(.+)}{} ) {
87                                    foreach my $p ( split(/[&;]/, $1) ) {
88                                            my ($n,$v) = split(/=/, $p, 2);
89                                            $param->{$n} = $v;
90                                    }
91                                    warn "<< param: ",dump( $param );
92                            }
93                          if ( my $path = static( $client,$1 ) ) {                          if ( my $path = static( $client,$1 ) ) {
94                                  warn ">> $path";                                  warn ">> $path";
95                          } elsif ( $method =~ m{/scan} ) {                          } elsif ( $method =~ m{/scan} ) {
                                 my $callback = $1 if $method =~ m{\?callback=([^&;]+)};  
96                                  my $tags = scan_for_tags();                                  my $tags = scan_for_tags();
97                                  my $json;                                  my $json = {};
98                                  map {                                  map {
99                                          my $d = decode_tag($_);                                          my $d = decode_tag($_);
100                                          $d->{sid} = $_;                                          $d->{sid} = $_;
101                                          push @{ $json->{tags} },  $d;                                          push @{ $json->{tags} },  $d;
102                                  } keys %$tags;                                  } keys %$tags;
103                                  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",
104                                            $param->{callback}, "(", to_json($json), ")\r\n";
105                          } else {                          } else {
106                                  print $client "HTTP/1.0 404 Unkown method\r\n";                                  print $client "HTTP/1.0 404 Unkown method\r\n";
107                          }                          }
# Line 106  sub http_server { Line 114  sub http_server {
114          die "server died";          die "server died";
115  }  }
116    
117    
118    my $last_message = {};
119    sub _message {
120            my $type = shift @_;
121            my $text = join(' ',@_);
122            my $last = $last_message->{$type};
123            if ( $text ne $last ) {
124                    warn $type eq 'diag' ? '# ' : '', $text, "\n";
125                    $last_message->{$type} = $text;
126            }
127    }
128    
129    sub _log { _message('log',@_) };
130    sub diag { _message('diag',@_) };
131    
132  my $debug = 0;  my $debug = 0;
133    
134  my $device    = "/dev/ttyUSB0";  my $device    = "/dev/ttyUSB0";
# Line 146  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 209  $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 236  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 264  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.44  
changed lines
  Added in v.48
  ViewVC Help
Powered by ViewVC 1.1.26