lib/Onis/Plugins/Bignumbers.pm

   1 package Onis::Plugins::Bignumbers;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Exporter;
   7
   8 use Onis::Html (qw(get_filehandle));
   9 use Onis::Language (qw(translate));
  10 use Onis::Data::Core (qw(get_main_nick register_plugin nick_to_name));
  11 use Onis::Data::Persistent ();
  12 use Onis::Plugins::Core (qw(get_core_nick_counters nick_is_in_main_table));
  13
  14 =head1 NAME
  15
  16 Onis::Plugins::Bignumbers - Information about nick specific channel
  17 characteristics
  18
  19 =head1 DESCRIPTION
  20
  21 This plugins detects questions, yelled text (all uppercase), (happy and sad)
  22 smileys, characters and words per line. It stores this information for each
  23 nick and prints a table containing the most significant nicks in each category.
  24
  25 =cut
  26
  27 @Onis::Plugins::Bignumbers::EXPORT_OK = (qw(get_bignumbers));
  28 @Onis::Plugins::Bignumbers::ISA = ('Exporter');
  29
  30 our $BigNumbers = Onis::Data::Persistent->new ('BigNumbers', 'nick', qw(questions uppercase smiley_happy smiley_sad));
  31 our $CalcData = {};
  32
  33 register_plugin ('TEXT', \&add);
  34 register_plugin ('ACTION', \&add);
  35 register_plugin ('OUTPUT', \&output);
  36
  37 my $VERSION = '$Id$';
  38 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
  39
  40 return (1);
  41
  42 sub add
  43 {
  44         my $data = shift;
  45
  46         my $nick = $data->{'nick'};
  47         my $text = $data->{'text'};
  48
  49         my $mod = 0;
  50
  51         my @nums = $BigNumbers->get ($nick);
  52         if (!@nums)
  53         {
  54                 @nums = (0, 0, 0, 0);
  55                 $mod++;
  56         }
  57
  58         if ($text =~ m/\b\?/)
  59         {
  60                 $nums[0]++;
  61                 $mod++;
  62         }
  63
  64         if ((uc ($text) eq $text) and ($text =~ m/[A-Z]/))
  65         {
  66                 $nums[1]++;
  67                 $mod++;
  68         }
  69
  70         if ($text =~ m/( |^)[;:]-?\)( |$)/)
  71         {
  72                 $nums[2]++;
  73                 $mod++;
  74         }
  75
  76         if ($text =~ m/( |^):-?\(( |$)/)
  77         {
  78                 $nums[3]++;
  79                 $mod++;
  80         }
  81
  82         if ($mod)
  83         {
  84                 $BigNumbers->put ($nick, @nums);
  85         }
  86
  87         return (1);
  88 }
  89
  90 sub calculate
  91 {
  92         for ($BigNumbers->keys ())
  93         {
  94                 my $nick = $_;
  95                 my $main = get_main_nick ($nick);
  96                 my ($questions, $uppercase, $smiley_happy, $smiley_sad) = $BigNumbers->get ($nick);
  97
  98                 next unless (defined ($smiley_sad));
  99
 100                 if (!defined ($CalcData->{$main}))
 101                 {
 102                         my $core_data = get_core_nick_counters ($main);
 103                         next unless (%$core_data);
 104
 105                         $CalcData->{$main} =
 106                         {
 107                                 lines => $core_data->{'lines_total'},
 108                                 words => $core_data->{'words_total'},
 109                                 chars => $core_data->{'chars_total'},
 110                                 questions    => 0,
 111                                 uppercase    => 0,
 112                                 smiley_happy => 0,
 113                                 smiley_sad   => 0
 114                         };
 115                 }
 116
 117                 $CalcData->{$main}{'questions'}    += $questions;
 118                 $CalcData->{$main}{'uppercase'}    += $uppercase;
 119                 $CalcData->{$main}{'smiley_happy'} += $smiley_happy;
 120                 $CalcData->{$main}{'smiley_sad'}   += $smiley_sad;
 121         }
 122 }
 123
 124 sub output
 125 {
 126         calculate ();
 127
 128         my $first_nick;
 129         my $first_name;
 130         my $second_nick;
 131         my $second_name;
 132         my $trans;
 133
 134         my $fh = get_filehandle ();
 135
 136         $trans = translate ('Big Numbers');
 137         print $fh <<EOF;
 138 <table class="plugin bignumbers">
 139   <tr>
 140     <th>$trans</th>
 141   </tr>
 142 EOF
 143         ($first_nick, $second_nick) = sort_by_field ('questions');
 144         if ($first_nick)
 145         {
 146                 my $percent = 100 * $CalcData->{$first_nick}{'questions'} / $CalcData->{$first_nick}{'lines'};
 147                 my $trans = translate ('questions0: %s %2.1f%%');
 148                 $first_name = nick_to_name ($first_nick) || $first_nick;
 149
 150                 print $fh "  <tr>\n    <td>";
 151                 printf $fh ($trans, $first_name, $percent);
 152
 153                 if ($second_nick)
 154                 {
 155                         $percent = 100 * $CalcData->{$second_nick}{'questions'} / $CalcData->{$second_nick}{'lines'};
 156                         $trans = translate ('questions1: %s %2.1f%%');
 157                         $second_name = nick_to_name ($second_nick) || $second_nick;
 158
 159                         print $fh "<br />\n",
 160                         qq#      <span class="small">#;
 161                         printf $fh ($trans, $second_name, $percent);
 162                         print $fh '</span>';
 163                 }
 164
 165                 print $fh "</td>\n  </tr>\n";
 166         }
 167
 168         ($first_nick, $second_nick) = sort_by_field ('uppercase');
 169         if ($first_nick)
 170         {
 171                 my $percent = 100 * $CalcData->{$first_nick}{'uppercase'} / $CalcData->{$first_nick}{'lines'};
 172                 my $trans = translate ('yells0: %s %2.1f%%');
 173                 $first_name = nick_to_name ($first_nick) || $first_nick;
 174
 175                 print $fh "  <tr>\n    <td>";
 176                 printf $fh ($trans, $first_name, $percent);
 177
 178                 if ($second_nick)
 179                 {
 180                         $percent = 100 * $CalcData->{$second_nick}{'uppercase'} / $CalcData->{$second_nick}{'lines'};
 181                         $trans = translate ('yells1: %s %2.1f%%');
 182                         $second_name = nick_to_name ($second_nick) || $second_nick;
 183
 184                         print $fh "<br />\n",
 185                         qq#      <span class="small">#;
 186                         printf $fh ($trans, $second_name, $percent);
 187                         print $fh "</span>";
 188                 }
 189
 190                 print $fh "</td>\n  </tr>\n";
 191         }
 192
 193         ($first_nick, $second_nick) = sort_by_field ('smiley_happy');
 194         if ($first_nick)
 195         {
 196                 my $percent = 100 * $CalcData->{$first_nick}{'smiley_happy'} / $CalcData->{$first_nick}{'lines'};
 197                 my $trans = translate ('happy0: %s %2.1f%%');
 198                 $first_name = nick_to_name ($first_nick) || $first_nick;
 199
 200                 print $fh "  <tr>\n    <td>";
 201                 printf $fh ($trans, $first_name, $percent);
 202
 203                 if ($second_nick)
 204                 {
 205                         $percent = 100 * $CalcData->{$second_nick}{'smiley_happy'} / $CalcData->{$second_nick}{'lines'};
 206                         $trans = translate ('happy1: %s %2.1f%%');
 207                         $second_name = nick_to_name ($second_nick) || $second_nick;
 208
 209                         print $fh "<br />\n",
 210                         qq#      <span class="small">#;
 211                         printf $fh ($trans, $second_name, $percent);
 212                         print $fh "</span>";
 213                 }
 214
 215                 print $fh "</td>\n  </tr>\n";
 216         }
 217
 218         ($first_nick, $second_nick) = sort_by_field ('smiley_sad');
 219         if ($first_nick)
 220         {
 221                 my $percent = 100 * $CalcData->{$first_nick}{'smiley_sad'} / $CalcData->{$first_nick}{'lines'};
 222                 my $trans = translate ('sad0: %s %2.1f%%');
 223                 $first_name = nick_to_name ($first_nick) || $first_nick;
 224
 225                 print $fh "  <tr>\n    <td>";
 226                 printf $fh ($trans, $first_name, $percent);
 227
 228                 if ($second_nick)
 229                 {
 230                         $percent = 100 * $CalcData->{$second_nick}{'smiley_sad'} / $CalcData->{$second_nick}{'lines'};
 231                         $trans = translate ('sad1: %s %2.1f%%');
 232                         $second_name = nick_to_name ($second_nick) || $second_nick;
 233
 234                         print $fh "<br />\n",
 235                         qq#      <span class="small">#;
 236                         printf $fh ($trans, $second_name, $percent);
 237                         print $fh "</span>";
 238                 }
 239
 240                 print $fh "</td>\n  </tr>\n";
 241         }
 242
 243         {
 244                 my @names = sort_by_field ('chars');
 245
 246                 my $longest = '';
 247                 my $longest2 = '';
 248                 my $shortest = '';
 249                 my $shortest2 = '';
 250
 251                 my $chan_chars = 0;
 252                 my $chan_lines = 0;
 253
 254                 for (@names)
 255                 {
 256                         $chan_chars += $CalcData->{$_}{'chars'} || 0;
 257                         $chan_lines += $CalcData->{$_}{'lines'} || 0;
 258                 }
 259
 260                 if (@names)
 261                 {
 262                         $longest = shift (@names);
 263                 }
 264                 if (@names)
 265                 {
 266                         $longest2 = shift (@names);
 267                 }
 268                 if (@names)
 269                 {
 270                         $shortest = pop (@names);
 271                 }
 272                 if (@names)
 273                 {
 274                         $shortest2 = pop (@names);
 275                 }
 276
 277                 if ($longest)
 278                 {
 279                         my $avg = $CalcData->{$longest}{'chars'} / $CalcData->{$longest}{'lines'};
 280                         my $trans = translate ('max chars0: %s %1.1f');
 281                         $first_name = nick_to_name ($longest) || $longest;
 282
 283                         print $fh "  <tr>\n    <td>";
 284                         printf $fh ($trans, $first_name, $avg);
 285
 286                         if ($longest2)
 287                         {
 288                                 $avg = $CalcData->{$longest2}{'chars'} / $CalcData->{$longest2}{'lines'};
 289                                 $trans = translate ('max chars1: %s %1.1f');
 290                                 $second_name = nick_to_name ($longest2) || $longest2;
 291
 292                                 print $fh "<br />\n",
 293                                 qq#      <span class="small">#;
 294                                 printf $fh ($trans, $second_name, $avg);
 295                                 print $fh "</span>";
 296                         }
 297
 298                         $avg = $chan_chars / $chan_lines;
 299                         $trans = translate ('chars avg: %1.1f');
 300
 301                         print $fh "<br />\n",
 302                         qq#      <span class="small">#;
 303                         printf $fh ($trans, $avg);
 304                         print $fh "</span></td>\n  </tr>\n";
 305                 }
 306
 307                 if ($shortest)
 308                 {
 309                         my $avg = $CalcData->{$shortest}{'chars'} / $CalcData->{$shortest}{'lines'};
 310                         my $trans = translate ('min chars0: %s %1.1f');
 311                         $first_name = nick_to_name ($shortest) || $shortest;
 312
 313                         print $fh "  <tr>\n    <td>";
 314                         printf $fh ($trans, $first_name, $avg);
 315
 316                         if ($shortest2)
 317                         {
 318                                 $avg = $CalcData->{$shortest2}{'chars'} / $CalcData->{$shortest2}{'lines'};
 319                                 $trans = translate ('min chars1: %s %1.1f');
 320                                 $second_name = nick_to_name ($shortest2) || $shortest2;
 321
 322                                 print $fh "<br />\n",
 323                                 qq#      <span class="small">#;
 324                                 printf $fh ($trans, $second_name, $avg);
 325                                 print $fh "</span>";
 326                         }
 327                         print $fh "</td>\n  </tr>\n";
 328                 }
 329         }
 330
 331         {
 332                 my @names = sort_by_field ('words');
 333
 334                 $first_nick = '';
 335                 $second_nick = '';
 336
 337                 my $chan_words = 0;
 338                 my $chan_lines = 0;
 339
 340                 for (@names)
 341                 {
 342                         $chan_words += $CalcData->{$_}{'words'} || 0;
 343                         $chan_lines += $CalcData->{$_}{'lines'} || 0;
 344                 }
 345
 346                 if (@names)
 347                 {
 348                         $first_nick = shift (@names);
 349                 }
 350                 if (@names)
 351                 {
 352                         $second_nick = shift (@names);
 353                 }
 354
 355                 if ($first_nick)
 356                 {
 357                         my $avg = $CalcData->{$first_nick}{'words'} / $CalcData->{$first_nick}{'lines'};
 358                         my $trans = translate ('max words0: %s %1.1f');
 359                         $first_name = nick_to_name ($first_nick) || $first_nick;
 360
 361                         print $fh "  <tr>\n    <td>";
 362                         printf $fh ($trans, $first_name, $avg);
 363
 364                         if ($second_nick)
 365                         {
 366                                 $avg = $CalcData->{$second_nick}{'words'} / $CalcData->{$second_nick}{'lines'};
 367                                 $trans = translate ('max words1: %s %1.1f');
 368                                 $second_name = nick_to_name ($second_nick) || $second_nick;
 369
 370                                 print $fh "<br />\n",
 371                                 qq#      <span class="small">#;
 372                                 printf $fh ($trans, $second_name, $avg);
 373                                 print $fh "</span>";
 374                         }
 375
 376                         $avg = $chan_words / $chan_lines;
 377                         $trans = translate ('words avg: %1.1f');
 378
 379                         print $fh "<br />\n",
 380                         qq#      <span class="small">#;
 381                         printf $fh ($trans, $avg);
 382                         print $fh "</span></td>\n  </tr>\n";
 383                 }
 384         }
 385
 386         print $fh "</table>\n\n";
 387 }
 388
 389 sub sort_by_field
 390 {
 391         my $field = shift;
 392
 393         my @retval = sort
 394         {
 395                 ($CalcData->{$b}{$field} / $CalcData->{$b}{'lines'})
 396                 <=>
 397                 ($CalcData->{$a}{$field} / $CalcData->{$a}{'lines'})
 398         } grep
 399         {
 400                 defined ($CalcData->{$_}{'lines'})
 401                         and ($CalcData->{$_}{'lines'} != 0)
 402                         and defined ($CalcData->{$_}{$field})
 403                         and (nick_is_in_main_table ($_) > 0)
 404         }
 405         (keys (%$CalcData));
 406
 407         while (scalar (@retval) < 2)
 408         {
 409                 push (@retval, '');
 410         }
 411
 412         return (@retval);
 413 }
 414
 415 =head1 EXPORTED FUNCTIONS
 416
 417 =over 4
 418
 419 =item B<get_bignumbers> (I<$nick>)
 420
 421 Returns all the data that was used to calculate the bignumbers-data for this
 422 nick. It's a hash-ref with the following fields. Each field holds a counter
 423 that counts the total occurences of that "event".
 424
 425   lines
 426   words
 427   chars
 428   questions
 429   uppercase
 430   smiley_happy
 431   smiley_sad
 432
 433 =cut
 434
 435 sub get_bignumbers
 436 {
 437         my $nick = shift;
 438
 439         if (!defined ($CalcData->{$nick}))
 440         {
 441                 return ({});
 442         }
 443
 444         return ($CalcData->{$nick});
 445 }
 446
 447 =back
 448
 449 =head1 AUTHOR
 450
 451 Florian Forster E<lt>octo at verplant.orgE<gt>
 452
 453 =cut