chat/bots/kharmabot.pl

   1 #!/usr/bin/perl -w -T
   2
   3 use strict;
   4
   5 # Configure this to the location of your kharma database.
   6 my $kharma_db = "/var/tmp/kharma.db";
   7
   8 # This should probably be a real Perl module ...
   9 require "/usr/share/monolith-chat/bots/chatbotlib.pl";
  10
  11 cb_init (\@ARGV);
  12
  13 # Get a list of all rooms.
  14 my @rooms = cb_get_all_rooms ();
  15
  16 # Kharma.
  17 my %kharma;
  18 dbmopen %kharma, $kharma_db, 0666;
  19
  20 for (;;)
  21 {
  22     # Get next posting message.
  23     my $msg = cb_wait_message (rooms => \@rooms,
  24                                msgtypes => CB_POSTING);
  25     my $userid = $msg->{userid};
  26     my $resid = $msg->{resid};
  27     my $text = $msg->{text};
  28
  29     # Only ordinary users are allowed to change kharma.
  30     if ($userid > 0)
  31     {
  32         # Does it contain [some word]++ or [some word]--?
  33         change_kharma ($_, 1, $resid, $userid)
  34             foreach (map { lc } ($text =~ m/\b([-\w.]+)\+\+\b/g));
  35         change_kharma ($_, -1, $resid, $userid)
  36             foreach (map { lc } ($text =~ m/\b([-\w.]+)--\b/g));
  37     }
  38
  39     # User is asking for the ranking of a particular word.
  40     if ($text =~ /^rank\s+([-\w.]+)\s*$/i)
  41     {
  42         my $word = lc $1;
  43
  44         if (! exists $kharma{$word})
  45         {
  46             cb_post_message
  47                 (room => $resid,
  48                  text => "$word has no kharma");
  49         }
  50         else
  51         {
  52             my $k = $kharma{$word};
  53
  54             if ($k == 1)
  55             {
  56                 cb_post_message
  57                     (room => $resid,
  58                      text => "$word has 1 point of kharma");
  59             }
  60             else
  61             {
  62                 cb_post_message
  63                     (room => $resid,
  64                      text => "$word has $k points of kharma");
  65             }
  66         }
  67
  68     }
  69 }
  70
  71 sub change_kharma
  72 {
  73     my $word = shift;
  74     my $change = shift;
  75     my $resid = shift;
  76     my $userid = shift;
  77
  78     if (! exists $kharma{$word})
  79     {
  80         $kharma{$word} = 0;
  81     }
  82
  83     # XXX Check that users don't change kharma too frequently.
  84     $kharma{$word} += $change;
  85     my $k = $kharma{$word};
  86
  87     # Garbage collected?
  88     if ($k == 0)
  89     {
  90         delete $kharma{$word};
  91
  92         cb_post_message
  93             (room => $resid,
  94              text => "$word has no kharma and has been garbage collected");
  95     }
  96     elsif ($k == 1)
  97     {
  98         cb_post_message
  99             (room => $resid,
 100              text => "$word has 1 point of kharma");
 101     }
 102     else
 103     {
 104         cb_post_message
 105             (room => $resid,
 106              text => "$word has $k points of kharma");
 107     }
 108 }