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