lib/Onis/Plugins/Interestingnumbers.pm

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