display presence in web browser

[MQR.git] / scripts / mqr-httpd.pl
diff --git a/scripts/mqr-httpd.pl b/scripts/mqr-httpd.pl

index 25202a9..8bf96c2 100755 (executable)
--- a/scripts/mqr-httpd.pl
+++ b/scripts/mqr-httpd.pl
@@ -3,18 +3,41 @@ use common::sense;
  use AnyEvent;
  use AnyEvent::HTTPD;
  
+use Data::Dump qw(dump);
+use Redis;
+
+
  my $cvar = AnyEvent->condvar;
  
  my $httpd = AnyEvent::HTTPD->new (port => 19090);
  
  $httpd->reg_cb (
     '' => sub {
-      my ($httpd, $req) = @_;
-      $req->respond ({ content => ['text/html', <<'CONT']});
-         <html><body><h1>Hello World!</h1>
-         <a href="/test">another test page</a>
-         </body></html>
-CONT
+       my ($httpd, $req) = @_;
+
+       my $body = qq{
+               <html><body><h1>Presence</h1>
+       };
+
+       my $redis = Redis->new;
+
+       my @accounts = $redis->keys( 'presence/*' );
+
+       warn "# accounts ",dump @accounts;
+       foreach my $who ( @accounts ) {
+               $body .= qq{<h2>$who</h2>\n<ul>\n};
+               my $members = $redis->smembers( $who );
+               warn "# members ",dump $members;
+               $body .= join("\n", map { "<li>$_" } @$members);
+               $body .= qq{</ul>\n};
+       }
+
+       $body .= qq{
+               </body></html>
+       };
+       warn $body;
+       $req->respond ({ content => ['text/html', $body]});
+
     },
     '/test' => sub {
        my ($httpd, $req) = @_;