--- 3m-810.pl	2009/06/24 10:13:23	51
+++ 3m-810.pl	2010/02/09 13:55:18	61
@@ -9,12 +9,17 @@
 use Getopt::Long;
 use File::Slurp;
 use JSON;
+use POSIX qw(strftime);
 
 use IO::Socket::INET;
 
 my $debug = 0;
 
-my $meteor_server = '192.168.1.13:4671';
+my $tags_data;
+my $tags_security;
+my $visible_tags;
+
+my $meteor_server; # = '192.168.1.13:4671';
 my $meteor_fh;
 
 sub meteor {
@@ -42,6 +47,8 @@
 }
 
 my $listen_port = 9000;                  # pick something not in use
+my $server_url  = "http://localhost:$listen_port";
+
 sub http_server {
 
 	my $server = IO::Socket::INET->new(
@@ -53,12 +60,13 @@
 								  
 	die "can't setup server" unless $server;
 
-	print "Server $0 accepting clients at http://localhost:$listen_port/\n";
+	print "Server $0 ready at $server_url\n";
 
 	sub static {
 		my ($client,$path) = @_;
 
 		$path = "www/$path";
+		$path .= 'rfid.html' if $path =~ m{/$};
 
 		return unless -e $path;
 
@@ -96,14 +104,31 @@
 				warn "WEB >> $path" if $debug;
 			} elsif ( $method =~ m{/scan} ) {
 				my $tags = scan_for_tags();
-				my $json = {};
+				my $json = { time => time() };
 				map {
 					my $d = decode_tag($_);
 					$d->{sid} = $_;
+					$d->{security} = $tags_security->{$_};
 					push @{ $json->{tags} },  $d;
 				} keys %$tags;
 				print $client "HTTP/1.0 200 OK\r\nContent-Type: application/x-javascript\r\n\r\n",
 					$param->{callback}, "(", to_json($json), ")\r\n";
+			} elsif ( $method =~ m{/program} ) {
+
+				my $status = 501; # Not implementd
+
+				foreach my $p ( keys %$param ) {
+					next unless $p =~ m/^tag_(\S+)/;
+					my $tag = $1;
+					my $content = "\x04\x11\x00\x01" . $param->{$p};
+					$status = 302;
+
+					warn "PROGRAM $tag $content\n";
+					write_tag( $tag, $content );
+				}
+
+				print $client "HTTP/1.0 $status $method\r\nLocation: $server_url\r\n\r\n";
+
 			} else {
 				print $client "HTTP/1.0 404 Unkown method\r\n";
 			}
@@ -205,9 +230,6 @@
 
 =cut
 
-my $tags_data;
-my $visible_tags;
-
 my $item_type = {
 	1 => 'Book',
 	6 => 'CD/CD ROM',
@@ -297,7 +319,10 @@
 if ( $http_server ) {
 	http_server;
 } else {
-	scan_for_tags while 1;
+	while (1) {
+		scan_for_tags;
+		sleep 1;
+	}
 }
 
 die "over and out";
@@ -373,6 +398,8 @@
 	return $last_block + 1;
 }
 
+my $saved_in_log;
+
 sub decode_tag {
 	my $tag = shift;
 
@@ -394,6 +421,12 @@
 		custom => $custom,
 	};
 
+	if ( ! $saved_in_log->{$tag}++ ) {
+		open(my $log, '>>', 'rfid-log.txt');
+		print $log strftime( "%Y-%m-%d %H:%M:%S", localtime ), ",$tag,$content\n";
+		close($log);
+	}
+
 	return $hash;
 }
 
@@ -432,6 +465,7 @@
 			( $from_tag, $security ) = ( substr($rest,0,8), substr($rest,8,1) );
 			die "security from other tag: ",as_hex( $from_tag ) if $from_tag ne str2bytes( $tag );
 			$security = as_hex( $security );
+			$tags_security->{$tag} = $security;
 			warn "# SECURITY $tag = $security\n";
 		}
 	);
@@ -440,11 +474,13 @@
 }
 
 sub write_tag {
-	my ($tag) = @_;
+	my ($tag,$data) = @_;
 
 	my $path = "$program_path/$tag";
+	$data = read_file( $path ) if -e $path;
+
+	die "no data" unless $data;
 
-	my $data = read_file( $path );
 	my $hex_data;
 
 	if ( $data =~ s{^hex\s+}{} ) {
@@ -657,7 +693,7 @@
 		warn "## DISPATCH payload to with rest", dump( $payload, $to, $rest ) if $debug;
 		$dispatch->{ $to }->( $rest );
 	} else {
-		print "NO DISPATCH for ",dump( $full ),"\n";
+		print "NO DISPATCH for ",as_hex( $full ),"\n";
 	}
 
 	return $data;