lib/Onis/Plugins/Interestingnumbers.pm

   1 package Onis::Plugins::Interestingnumbers;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Onis::Config (qw(get_config));
   7 use Onis::Html (qw(html_escape get_filehandle));
   8 use Onis::Language (qw(translate));
   9 use Onis::Data::Core (qw(register_plugin));
  10 use Onis::Data::Persistent;
  11 use Onis::Users (qw(nick_to_name));
  12
  13 register_plugin ('ACTION', \&add_action);
  14 register_plugin ('JOIN', \&add_join);
  15 register_plugin ('KICK', \&add_kick);
  16 register_plugin ('MODE', \&add_mode);
  17 register_plugin ('TEXT', \&add_text);
  18 register_plugin ('OUTPUT', \&output);
  19
  20 our $InterestingNumbersCache = Onis::Data::Persistent->new ('InterestingNumbersCache', 'nick', qw(actions joins kicks_given kicks_received ops_given ops_taken soliloquies));
  21 our $InterestingNumbersData = {};
  22
  23 our $SoliloquiesNick = '';
  24 our $SoliloquiesCount = 0;
  25
  26 our $SOLILOQUIES_COUNT = 5;
  27 if (get_config ('soliloquies_count'))
  28 {
  29         my $tmp = get_config ('soliloquies_count');
  30         $tmp =~ s/\D//g;
  31
  32         $SOLILOQUIES_COUNT = $tmp if ($tmp);
  33 }
  34
  35 my $VERSION = '$Id$';
  36 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
  37
  38 return (1);
  39
  40 sub get_or_empty
  41 {
  42         my $nick = shift;
  43         my @data = $InterestingNumbersCache->get ($nick);
  44         @data = (0, 0, 0, 0, 0, 0) unless (@data);
  45         return (@data);
  46 }
  47
  48 sub add_action
  49 {
  50         my $data = shift;
  51         my $nick = $data->{'nick'};
  52
  53         my @data = get_or_empty ($nick);
  54         $data[0]++;
  55         $InterestingNumbersCache->put ($nick, @data);
  56 }
  57
  58 sub add_join
  59 {
  60         my $data = shift;
  61         my $nick = $data->{'nick'};
  62
  63         my @data = get_or_empty ($nick);
  64         $data[1]++;
  65         $InterestingNumbersCache->put ($nick, @data);
  66 }
  67
  68 sub add_kick
  69 {
  70         my $data = shift;
  71
  72         my $nick_g = $data->{'nick'};
  73         my $nick_r = $data->{'nick_received'};
  74
  75         my @data = get_or_empty ($nick_g);
  76         $data[2]++;
  77         $InterestingNumbersCache->put ($nick_g, @data);
  78
  79         @data = get_or_empty ($nick_r);
  80         $data[3]++;
  81         $InterestingNumbersCache->put ($nick_r, @data);
  82 }
  83
  84 sub add_mode
  85 {
  86         my $data = shift;
  87
  88         my $nick = $data->{'nick'};
  89         my $text = $data->{'mode'};
  90
  91         my ($mode) = split (m/\s+/, $text);
  92         my $modifier = '';
  93
  94         for (split (m//, $mode))
  95         {
  96                 my $tmp = $_;
  97                 if (($tmp eq '-') or ($tmp eq '+'))
  98                 {
  99                         $modifier = $tmp;
 100                         next;
 101                 }
 102
 103                 next unless ($modifier);
 104
 105                 if ($tmp eq 'o')
 106                 {
 107                         my @data = get_or_empty ($nick);
 108                         if ($modifier eq '-')
 109                         {
 110                                 $data[5]++;
 111                         }
 112                         else # ($modifier eq '+')
 113                         {
 114                                 $data[4]++;
 115                         }
 116                 }
 117         }
 118
 119         return (1);
 120 }
 121
 122 sub add_text
 123 {
 124         my $data = shift;
 125
 126         my $nick = $data->{'nick'};
 127
 128         if ($nick eq $SoliloquiesNick)
 129         {
 130                 $SoliloquiesCount++;
 131
 132                 if ($SoliloquiesCount == $SOLILOQUIES_COUNT)
 133                 {
 134                         my @data = get_or_empty ($nick);
 135                         $data[6]++;
 136                         $InterestingNumbersCache->put ($nick, @data);
 137                 }
 138         }
 139         else
 140         {
 141                 $SoliloquiesNick = $nick;
 142                 $SoliloquiesCount = 1;
 143         }
 144 }
 145
 146 sub calculate
 147 {
 148         for ($InterestingNumbersCache->keys ())
 149         {
 150                 my $nick = $_;
 151                 my ($actions, $joins,
 152                         $kicks_given, $kicks_received,
 153                         $ops_given, $ops_taken,
 154                         $soliloquies) = $InterestingNumbersCache->get ($nick);
 155                 my $main = get_main_nick ($nick);
 156
 157                 die unless ($main);
 158
 159                 if (!defined ($InterestingNumbersData->{$main}))
 160                 {
 161                         $InterestingNumbersData->{$main} =
 162                         {
 163                                 actions         => 0,
 164                                 joins           => 0,
 165                                 kicks_given     => 0,
 166                                 kicks_received  => 0,
 167                                 ops_given       => 0,
 168                                 ops_taken       => 0,
 169                                 soliloquies     => 0
 170                         };
 171                 }
 172
 173                 $InterestingNumbersData->{$main}{'actions'}        += $actions;
 174                 $InterestingNumbersData->{$main}{'joins'}          += $joins;
 175                 $InterestingNumbersData->{$main}{'kicks_given'}    += $kicks_given;
 176                 $InterestingNumbersData->{$main}{'kicks_received'} += $kicks_received;
 177                 $InterestingNumbersData->{$main}{'ops_given'}      += $ops_given;
 178                 $InterestingNumbersData->{$main}{'ops_taken'}      += $ops_taken;
 179                 $InterestingNumbersData->{$main}{'soliloquies'}    += $soliloquies;
 180         }
 181 }
 182
 183
 184
 185
 186 sub output
 187 {
 188         calculate ();
 189
 190         my $first_nick;
 191         my $first_name;
 192         my $second_nick;
 193         my $second_name;
 194
 195         my $fh = get_filehandle ();
 196
 197         my $trans = translate ('Interesting Numbers');
 198
 199         print $fh <<EOF;
 200 <table class="plugin interestingnumbers">
 201   <tr>
 202     <th>$trans</th>
 203   </tr>
 204 EOF
 205         ($first_nick, $second_nick) = sort_by_field ('kick_received');
 206         if ($first_nick)
 207         {
 208                 my $num = $InterestingNumbersData->{$first_nick}{'kick_received'};
 209                 $trans = translate ('kick_received0: %s %u');
 210                 $first_name = nick_to_name ($first_nick) || $first_nick;
 211
 212                 print $fh "  <tr>\n    <td>";
 213                 printf $fh ($trans, $first_nick, $num);
 214
 215                 if ($second_nick)
 216                 {
 217                         $num = $InterestingNumbersData->{$second_nick}{'kick_received'};
 218                         $trans = translate ('kick_received1: %s %u');
 219                         $second_name = nick_to_name ($second_nick) || $second_nick;
 220
 221                         print $fh "<br />\n",
 222                         qq#      <span class="small">#;
 223                         printf $fh ($trans, $second_nick, $num);
 224                         print $fh '</span>';
 225                 }
 226
 227                 print $fh "</td>\n  </tr>\n";
 228         }
 229
 230         ($first_nick, $second_nick) = sort_by_field ('kick_given');
 231         if ($first_nick)
 232         {
 233                 my $num = $InterestingNumbersData->{$first_nick}{'kick_given'};
 234                 $trans = translate ('kick_given0: %s %u');
 235                 $first_name = nick_to_name ($first_nick) || $first_nick;
 236
 237                 print $fh "  <tr>\n    <td>";
 238                 printf $fh ($trans, $first_name, $num);
 239
 240                 if ($second_nick)
 241                 {
 242                         $num = $InterestingNumbersData->{$second_nick}{'kick_given'};
 243                         $trans = translate ('kick_given1: %s %u');
 244                         $second_name = nick_to_name ($second_nick) || $second_nick;
 245
 246                         print $fh "<br />\n",
 247                         qq#      <span class="small">#;
 248                         printf $fh ($trans, $second_name, $num);
 249                         print $fh '</span>';
 250                 }
 251
 252                 print $fh "</td>\n  </tr>\n";
 253         }
 254
 255         ($first_nick, $second_nick) = sort_by_field ('op_given');
 256         if ($first_nick)
 257         {
 258                 my $num = $InterestingNumbersData->{$first_nick}{'op_given'};
 259                 $trans = translate ('op_given0: %s %u');
 260                 $first_name = nick_to_name ($first_nick) || $first_nick;
 261
 262                 print $fh "  <tr>\n    <td>";
 263                 printf $fh ($trans, $first_name, $num);
 264
 265                 if ($second_nick)
 266                 {
 267                         $num = $InterestingNumbersData->{$second_nick}{'op_given'};
 268                         $trans = translate ('op_given1: %s %u');
 269                         $second_name = nick_to_name ($second_nick) || $second_nick;
 270
 271                         print $fh "<br />\n",
 272                         qq#      <span class="small">#;
 273                         printf $fh ($trans, $second_name, $num);
 274                         print $fh '</span>';
 275                 }
 276
 277                 print $fh "</td>\n  </tr>\n";
 278         }
 279
 280         ($first_nick, $second_nick) = sort_by_field ('op_taken');
 281         if ($first_nick)
 282         {
 283                 my $num = $InterestingNumbersData->{$first_nick}{'op_taken'};
 284                 $trans = translate ('op_taken0: %s %u');
 285                 $first_name = nick_to_name ($first_nick) || $first_nick;
 286
 287                 print $fh "  <tr>\n    <td>";
 288                 printf $fh ($trans, $first_name, $num);
 289
 290                 if ($second_nick)
 291                 {
 292                         $num = $InterestingNumbersData->{$second_nick}{'op_taken'};
 293                         $trans = translate ('op_taken1: %s %u');
 294                         $second_name = nick_to_name ($second_nick) || $second_nick;
 295
 296                         print $fh "<br />\n",
 297                         qq#      <span class="small">#;
 298                         printf $fh ($trans, $second_name, $num);
 299                         print $fh '</span>';
 300                 }
 301
 302                 print $fh "</td>\n  </tr>\n";
 303         }
 304
 305         ($first_nick, $second_nick) = sort_by_field ('actions');
 306         if ($first_nick)
 307         {
 308                 my $num = $InterestingNumbersData->{$first_nick}{'actions'};
 309                 $trans = translate ('action0: %s %u');
 310                 $first_name = nick_to_name ($first_nick) || $first_nick;
 311
 312                 print $fh "  <tr>\n    <td>";
 313                 printf $fh ($trans, $first_name, $num);
 314
 315                 if ($second_nick)
 316                 {
 317                         $num = $InterestingNumbersData->{$second_nick}{'actions'};
 318                         $trans = translate ('action1: %s %u');
 319                         $second_name = nick_to_name ($second_nick) || $second_nick;
 320
 321                         print $fh "<br />\n",
 322                         qq#      <span class="small">#;
 323                         printf $fh ($trans, $second_name, $num);
 324                         print $fh '</span>';
 325                 }
 326
 327                 print $fh "</td>\n  </tr>\n";
 328         }
 329
 330         ($first_nick, $second_nick) = sort_by_field ('soliloquies');
 331         if ($first_nick)
 332         {
 333                 my $num = $InterestingNumbersData->{$first_nick}{'soliloquies'};
 334                 $trans = translate ('soliloquies0: %s %u');
 335                 $first_name = nick_to_name ($first_nick) || $first_nick;
 336
 337                 print $fh "  <tr>\n    <td>";
 338                 printf $fh ($trans, $first_name, $num);
 339
 340                 if ($second_nick)
 341                 {
 342                         $num = $InterestingNumbersData->{$second_nick}{'soliloquies'};
 343                         $trans = translate ('soliloquies1: %s %u');
 344                         $second_name = nick_to_name ($second_nick) || $second_nick;
 345
 346                         print $fh "<br />\n",
 347                         qq#      <span class="small">#;
 348                         printf $fh ($trans, $second_name, $num);
 349                         print $fh '</span>';
 350                 }
 351
 352                 print $fh "</td>\n  </tr>\n";
 353         }
 354
 355         ($first_nick, $second_nick) = sort_by_field ('joins');
 356         if ($first_nick)
 357         {
 358                 my $num = $InterestingNumbersData->{$first_nick}{'joins'};
 359                 $trans = translate ('joins0: %s %u');
 360                 $first_name = nick_to_name ($first_nick) || $first_nick;
 361
 362                 print $fh "  <tr>\n    <td>";
 363                 printf $fh ($trans, $first_name, $num);
 364
 365                 if ($second_nick)
 366                 {
 367                         $num = $InterestingNumbersData->{$second_nick}{'joins'};
 368                         $trans = translate ('joins1: %s %u');
 369                         $second_name = nick_to_name ($second_nick) || $second_nick;
 370
 371                         print $fh "<br />\n",
 372                         qq#      <span class="small">#;
 373                         printf $fh ($trans, $second_name, $num);
 374                         print $fh '</span>';
 375                 }
 376
 377                 print $fh "</td>\n  </tr>\n";
 378         }
 379
 380         print $fh "</table>\n\n";
 381 }
 382
 383 sub sort_by_field
 384 {
 385         my $field = shift;
 386
 387         my @retval = sort
 388         {
 389                 $InterestingNumbersData->{$b}{$field}
 390                 <=>
 391                 $InterestingNumbersData->{$a}{$field}
 392         } (keys (%$InterestingNumbersData));
 393
 394         while (scalar (@retval) < 2)
 395         {
 396                 push (@retval, '');
 397         }
 398
 399         return (@retval);
 400 }