scripts/mqr-httpd.pl

   1 #!/usr/bin/perl
   2 use common::sense;
   3 use AnyEvent;
   4 use AnyEvent::HTTPD;
   5
   6 use Data::Dump qw(dump);
   7 use Redis;
   8
   9
  10 my $cvar = AnyEvent->condvar;
  11
  12 my $httpd = AnyEvent::HTTPD->new (port => 19090);
  13
  14 $httpd->reg_cb (
  15    '' => sub {
  16         my ($httpd, $req) = @_;
  17
  18         my $body = qq{
  19                 <html><body><h1>Presence</h1>
  20         };
  21
  22         my $redis = Redis->new;
  23
  24         my @accounts = $redis->keys( 'presence/*' );
  25
  26         warn "# accounts ",dump @accounts;
  27         foreach my $who ( @accounts ) {
  28                 $body .= qq{<h2>$who</h2>\n<ul>\n};
  29                 my $members = $redis->smembers( $who );
  30                 warn "# members ",dump $members;
  31                 $body .= join("\n", map { "<li>$_" } @$members);
  32                 $body .= qq{</ul>\n};
  33         }
  34
  35         $body .= qq{
  36                 </body></html>
  37         };
  38         warn $body;
  39         $req->respond ({ content => ['text/html', $body]});
  40
  41    },
  42    '/test' => sub {
  43       my ($httpd, $req) = @_;
  44       $httpd->stop_request;
  45
  46       $req->respond ({ content => ['text/html', <<'CONT']});
  47          <html><body><h1>Test page</h1>
  48          <a href="/">Back to the main page</a>
  49          </body></html>
  50 CONT
  51    },
  52 );
  53
  54 $cvar->wait;