--- 3m-810.pl	2009/06/04 13:52:10	42
+++ 3m-810.pl	2009/06/23 12:19:30	43
@@ -38,6 +38,70 @@
 	}
 }
 
+my $listen_port = 9000;                  # pick something not in use
+sub http_server {
+
+	my $server = IO::Socket::INET->new(
+		Proto     => 'tcp',
+		LocalPort => $listen_port,
+		Listen    => SOMAXCONN,
+		Reuse     => 1
+	);
+								  
+	die "can't setup server" unless $server;
+
+	print "Server $0 accepting clients at http://localhost:$listen_port/\n";
+
+	sub static {
+		my ($client,$path) = @_;
+
+		$path = "www/$path";
+
+		return unless -e $path;
+
+		my $type = 'text/plain';
+		$type = 'text/html' if $path =~ m{\.htm};
+		$type = 'application/javascript' if $path =~ m{\.js};
+
+		print $client "HTTP/1.0 200 OK\r\nContent-Type: $type\r\n\r\n";
+		open(my $html, $path);
+		while(<$html>) {
+			print $client $_;
+		}
+		close($html);
+
+		return $path;
+	}
+
+	while (my $client = $server->accept()) {
+		$client->autoflush(1);
+		my $request = <$client>;
+
+		warn "<< $request\n";
+
+		if ($request =~ m{^GET (/.*) HTTP/1.[01]}) {
+			my $method = $1;
+			if ( my $path = static( $client,$1 ) ) {
+				warn ">> $path";
+			} elsif ( $method =~ m{/scan} ) {
+				print $client "HTTP/1.0 200 OK\r\nContent-Type: text/plain\r\n\r\n";
+				my $tags = scan_for_tags();
+				print $client "tags: ",dump($tags);
+				my $json;
+				map { $json->{$_} = decode_tag($_) } keys %$tags;
+				print $client "decoded: ",dump( $json );
+			} else {
+				print $client "HTTP/1.0 404 Unkown method\r\n";
+			}
+		} else {
+			print $client "HTTP/1.0 500 No method\r\n";
+		}
+		close $client;
+	}
+
+	die "server died";
+}
+
 my $debug = 0;
 
 my $device    = "/dev/ttyUSB0";
@@ -50,6 +114,9 @@
 my $program_path = './program/';
 my $secure_path = './secure/';
 
+# http server
+my $http_server = 1;
+
 # 3M defaults: 8,4
 my $max_rfid_block = 16;
 my $read_blocks = 8;
@@ -161,39 +228,52 @@
 cmd( 'D6 00  0C   13  04  01 00  02 00  03 00  04 00   AAF2','FIXME: stats?',
      'D6 00  0C   13  00  02 01 01 03 02 02 03  00     E778', sub { assert() }  );
 
-# start scanning for tags
+sub scan_for_tags {
 
-cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags, retry $_",
-	 'D6 00  0F   FE  00 00  05 ', sub { # 01 E00401003123AA26  941A	 # seen, serial length: 8
-		my $rest = shift || die "no rest?";
-		my $nr = ord( substr( $rest, 0, 1 ) );
-
-		if ( ! $nr ) {
-			print "no tags in range\n";
-			update_visible_tags();
-			meteor( 'info-none-in-range' );
-			$tags_data = {};
-		} else {
+	my @tags;
 
-			my $tags = substr( $rest, 1 );
+	cmd( 'D6 00  05   FE     00  05         FA40', "scan for tags, retry $_",
+		 'D6 00  0F   FE  00 00  05 ', sub { # 01 E00401003123AA26  941A	 # seen, serial length: 8
+			my $rest = shift || die "no rest?";
+			my $nr = ord( substr( $rest, 0, 1 ) );
+
+			if ( ! $nr ) {
+				print "no tags in range\n";
+				update_visible_tags();
+				meteor( 'info-none-in-range' );
+				$tags_data = {};
+			} else {
+
+				my $tags = substr( $rest, 1 );
 
-			my $tl = length( $tags );
-			die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
+				my $tl = length( $tags );
+				die "wrong length $tl for $nr tags: ",dump( $tags ) if $tl =! $nr * 8;
 
-			my @tags;
-			push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 );
-			warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
-			print "$nr tags in range: ", join(',', @tags ) , "\n";
+				push @tags, uc(unpack('H16', substr($tags, $_ * 8, 8))) foreach ( 0 .. $nr - 1 );
+				warn "## tags ",as_hex($tags), " [$tl] = ",dump( $tags ) if $debug;
+				print "$nr tags in range: ", join(',', @tags ) , "\n";
 
-			meteor( 'info-in-range', join(' ',@tags));
+				meteor( 'info-in-range', join(' ',@tags));
 
-			update_visible_tags( @tags );
+				update_visible_tags( @tags );
+			}
 		}
-	}
-) while(1);
-#) foreach ( 1 .. 100 );
+	);
+
+	warn "## tags: ",dump( @tags );
+	return $tags_data;
 
+}
+
+# start scanning for tags
 
+if ( $http_server ) {
+	http_server;
+} else {
+	scan_for_tags while 1;
+}
+
+die "over and out";
 
 sub update_visible_tags {
 	my @tags = @_;
@@ -266,6 +346,30 @@
 	return $last_block + 1;
 }
 
+sub decode_tag {
+	my $tag = shift;
+
+	my $data = $tags_data->{$tag} || die "no data for $tag";
+
+	my ( $u1, $set_item, $u2, $type, $content, $br_lib, $custom ) = unpack('C4Z16Nl>',$data);
+	my $hash = {
+		u1 => $u1,
+		u2 => $u2,
+		set => ( $set_item & 0xf0 ) >> 4,
+		total => ( $set_item & 0x0f ),
+
+		type => $type,
+		content => $content,
+
+		branch => $br_lib >> 20,
+		library => $br_lib & 0x000fffff,
+
+		custom => $custom,
+	};
+
+	return $hash;
+}
+
 sub read_tag {
 	my ( $tag ) = @_;
 
@@ -305,14 +409,7 @@
 		}
 	);
 
-	my $data = $tags_data->{$tag} || die "no data for $tag";
-	my ( $u1, $set_item, $u2, $type, $content, $br_lib, $custom ) = unpack('C4Z16Nl>',$data);
-	my $set   = ( $set_item & 0xf0 ) >> 4;
-	my $total = ( $set_item & 0x0f );
-	my $branch  = $br_lib >> 20;
-	my $library = $br_lib & 0x000fffff;
-	print "TAG $tag [$u1] set: $set/$total [$u2] type: $type '$content' library: $library branch: $branch custom: $custom security: $security\n";
-
+	print "TAG $tag ", dump(decode_tag( $tag ));
 }
 
 sub write_tag {
@@ -500,7 +597,7 @@
 our $dispatch;
 
 sub readchunk {
-	sleep 1;	# FIXME remove
+#	sleep 1;	# FIXME remove
 
 	# read header of packet
 	my $header = read_bytes( 2, 'header' );