projects / MQR.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: b594dd0)
display presence in web browser master
authorDobrica Pavlinusic <dpavlin@rot13.org>
Tue, 7 Sep 2010 18:38:21 +0000 (18:38 +0000)
committerDobrica Pavlinusic <dpavlin@rot13.org>
Tue, 7 Sep 2010 18:38:21 +0000 (18:38 +0000)
Makefile.PL patch | blob | history
scripts/mqr-httpd.pl patch | blob | history

diff --git a/Makefile.PL b/Makefile.PL
index 2b84212..06aa8e2 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -17,6 +17,8 @@ requires 'Data::Dump';
 requires 'XML::Twig';
 requires 'Net::SSLeay';
 
+requires 'Redis' => 0.20; # I'm too stupid to figure AE::Redis
+
 auto_install;
 
 WriteAll;
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) = @_;
Message Queue Routing