/[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 58 by dpavlin, Sat Jul 4 08:33:56 2009 UTC revision 59 by dpavlin, Mon Nov 16 16:23:05 2009 UTC
# Line 9  use Carp qw/confess/; Line 9  use Carp qw/confess/;
9  use Getopt::Long;  use Getopt::Long;
10  use File::Slurp;  use File::Slurp;
11  use JSON;  use JSON;
12    use POSIX qw(strftime);
13    
14  use IO::Socket::INET;  use IO::Socket::INET;
15    
# Line 46  sub meteor { Line 47  sub meteor {
47  }  }
48    
49  my $listen_port = 9000;                  # pick something not in use  my $listen_port = 9000;                  # pick something not in use
50    my $server_url  = "http://localhost:$listen_port";
51    
52  sub http_server {  sub http_server {
53    
54          my $server = IO::Socket::INET->new(          my $server = IO::Socket::INET->new(
# Line 57  sub http_server { Line 60  sub http_server {
60                                                                                                                                        
61          die "can't setup server" unless $server;          die "can't setup server" unless $server;
62    
63          print "Server $0 accepting clients at http://localhost:$listen_port/\n";          print "Server $0 ready at $server_url\n";
64    
65          sub static {          sub static {
66                  my ($client,$path) = @_;                  my ($client,$path) = @_;
# Line 110  sub http_server { Line 113  sub http_server {
113                                  } keys %$tags;                                  } keys %$tags;
114                                  print $client "HTTP/1.0 200 OK\r\nContent-Type: application/x-javascript\r\n\r\n",                                  print $client "HTTP/1.0 200 OK\r\nContent-Type: application/x-javascript\r\n\r\n",
115                                          $param->{callback}, "(", to_json($json), ")\r\n";                                          $param->{callback}, "(", to_json($json), ")\r\n";
116                            } elsif ( $method =~ m{/program} ) {
117    
118                                    my $status = 501; # Not implementd
119    
120                                    foreach my $p ( keys %$param ) {
121                                            next unless $p =~ m/^tag_(\S+)/;
122                                            my $tag = $1;
123                                            my $content = $param->{$p};
124                                            $status = 302;
125    
126                                            warn "PROGRAM $tag $content\n";
127                                            write_tag( $tag, $content );
128                                    }
129    
130                                    print $client "HTTP/1.0 $status $method\r\nLocation: $server_url\r\n\r\n";
131    
132                          } else {                          } else {
133                                  print $client "HTTP/1.0 404 Unkown method\r\n";                                  print $client "HTTP/1.0 404 Unkown method\r\n";
134                          }                          }
# Line 379  sub read_tag_data { Line 398  sub read_tag_data {
398          return $last_block + 1;          return $last_block + 1;
399  }  }
400    
401    my $saved_in_log;
402    
403  sub decode_tag {  sub decode_tag {
404          my $tag = shift;          my $tag = shift;
405    
# Line 400  sub decode_tag { Line 421  sub decode_tag {
421                  custom => $custom,                  custom => $custom,
422          };          };
423    
424            if ( ! $saved_in_log->{$tag}++ ) {
425                    open(my $log, '>>', 'rfid-log.txt');
426                    print $log strftime( "%Y-%m-%d %H:%M:%S", localtime ), ",$tag,$content\n";
427                    close($log);
428            }
429    
430          return $hash;          return $hash;
431  }  }
432    
# Line 447  sub read_tag { Line 474  sub read_tag {
474  }  }
475    
476  sub write_tag {  sub write_tag {
477          my ($tag) = @_;          my ($tag,$data) = @_;
478    
479          my $path = "$program_path/$tag";          my $path = "$program_path/$tag";
480            $data = read_file( $path ) if -e $path;
481    
482            die "no data" unless $data;
483    
         my $data = read_file( $path );  
484          my $hex_data;          my $hex_data;
485    
486          if ( $data =~ s{^hex\s+}{} ) {          if ( $data =~ s{^hex\s+}{} ) {
Legend:
Removed from v.58  
changed lines
  Added in v.59
  ViewVC Help
Powered by ViewVC 1.1.26