lib/Onis/Plugins/Core.pm

   1 package Onis::Plugins::Core;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Carp (qw(confess));
   7 use Exporter;
   8
   9 =head1 NAME
  10
  11 Onis::Plugins::Core
  12
  13 =head1 DESCRIPTION
  14
  15 Plugin for the main table and the hourly-statistics. This is the most
  16 complicated plugin so far.
  17
  18 =cut
  19
  20 use Onis::Config (qw(get_config));
  21 use Onis::Html (qw(html_escape get_filehandle));
  22 use Onis::Language (qw(translate));
  23 use Onis::Users (qw(get_realname get_link get_image chatter_to_name));
  24 use Onis::Data::Core (qw(get_all_nicks nick_to_ident ident_to_nick get_main_nick register_plugin));
  25 use Onis::Data::Persistent ();
  26
  27 @Onis::Plugins::Core::EXPORT_OK = (qw(get_core_nick_counters get_sorted_nicklist nick_is_in_main_table));
  28 @Onis::Plugins::Core::ISA = ('Exporter');
  29
  30 our $NickLinesCounter = Onis::Data::Persistent->new ('NickLinesCounter', 'nick',
  31         qw(
  32                 lines00 lines01 lines02 lines03 lines04 lines05 lines06 lines07 lines08 lines09 lines10 lines11
  33                 lines12 lines13 lines14 lines15 lines16 lines17 lines18 lines19 lines20 lines21 lines22 lines23
  34         )
  35 );
  36 our $NickWordsCounter = Onis::Data::Persistent->new ('NickWordsCounter', 'nick',
  37         qw(
  38                 words00 words01 words02 words03 words04 words05 words06 words07 words08 words09 words10 words11
  39                 words12 words13 words14 words15 words16 words17 words18 words19 words20 words21 words22 words23
  40         )
  41 );
  42 our $NickCharsCounter = Onis::Data::Persistent->new ('NickCharsCounter', 'nick',
  43         qw(
  44                 chars00 chars01 chars02 chars03 chars04 chars05 chars06 chars07 chars08 chars09 chars10 chars11
  45                 chars12 chars13 chars14 chars15 chars16 chars17 chars18 chars19 chars20 chars21 chars22 chars23
  46         )
  47 );
  48
  49 our $QuoteCache = Onis::Data::Persistent->new ('QuoteCache', 'key', qw(epoch text));
  50 our $QuotePtr = Onis::Data::Persistent->new ('QuotePtr', 'nick', qw(pointer));
  51
  52 our $QuoteData = {};  # Is generated before output. Nicks are merged according to Data::Core.
  53 our $NickData = {};  # Same as above, but for nicks rather than quotes.
  54 our $SortedNicklist = [];
  55
  56 our $NicksInMainTable = {};
  57
  58 our @H_IMAGES = qw#dark-theme/h-red.png dark-theme/h-blue.png dark-theme/h-yellow.png dark-theme/h-green.png#;
  59 our $QuoteCacheSize = 10;
  60 our $QuoteMin = 30;
  61 our $QuoteMax = 80;
  62 our $WORD_LENGTH = 5;
  63 our $SORT_BY = 'LINES';
  64 our $DISPLAY_LINES = 'BOTH';
  65 our $DISPLAY_WORDS = 'NONE';
  66 our $DISPLAY_CHARS = 'NONE';
  67 our $DISPLAY_TIMES = 0;
  68 our $DISPLAY_IMAGES = 0;
  69 our $DEFAULT_IMAGE = '';
  70 our $BAR_HEIGHT = 130;
  71 our $BAR_WIDTH  = 100;
  72 our $LongLines  = 50;
  73 our $ShortLines = 10;
  74
  75 =head1 CONFIGURATION OPTIONS
  76
  77 =over 4
  78
  79 =item B<quote_cache_size>: I<10>
  80
  81 Sets how many quotes are cached and, at the end, one is chosen at random.
  82
  83 =cut
  84
  85 if (get_config ('quote_cache_size'))
  86 {
  87         my $tmp = get_config ('quote_cache_size');
  88         $tmp =~ s/\D//g;
  89         $QuoteCacheSize = $tmp if ($tmp);
  90 }
  91
  92 =item B<quote_min>: I<30>
  93
  94 Minimum number of characters in a line to be included in the quote-cache.
  95
  96 =cut
  97
  98 if (get_config ('quote_min'))
  99 {
 100         my $tmp = get_config ('quote_min');
 101         $tmp =~ s/\D//g;
 102         $QuoteMin = $tmp if ($tmp);
 103 }
 104 =item B<quote_max>: I<80>
 105
 106 Maximum number of characters in a line to be included in the quote-cache.
 107
 108 =cut
 109
 110 if (get_config ('quote_max'))
 111 {
 112         my $tmp = get_config ('quote_max');
 113         $tmp =~ s/\D//g;
 114         $QuoteMax = $tmp if ($tmp);
 115 }
 116
 117 =item B<min_word_length>: I<5>
 118
 119 Sets how many word-characters in a row are considered to be a word. Or, in more
 120 normal terms: Sets the minimum length for words..
 121
 122 =cut
 123
 124 if (get_config ('min_word_length'))
 125 {
 126         my $tmp = get_config ('min_word_length');
 127         $tmp =~ s/\D//g;
 128         $WORD_LENGTH = $tmp if ($tmp);
 129 }
 130
 131 =item B<display_lines>: I<BOTH>
 132
 133 Choses wether to display B<lines> as I<BAR>, I<NUMBER>, I<BOTH> or not at all
 134 (I<NONE>).
 135
 136 =cut
 137
 138 if (get_config ('display_lines'))
 139 {
 140         my $tmp = get_config ('display_lines');
 141         $tmp = uc ($tmp);
 142
 143         if (($tmp eq 'NONE') or ($tmp eq 'BAR') or ($tmp eq 'NUMBER') or ($tmp eq 'BOTH'))
 144         {
 145                 $DISPLAY_LINES = $tmp;
 146         }
 147         else
 148         {
 149                 $tmp = get_config ('display_lines');
 150                 print STDERR $/, __FILE__, ": ``display_lines'' has been set to the invalid value ``$tmp''. ",
 151                 $/, __FILE__, ": Valid values are ``none'', ``bar'', ``number'' and ``both''. Using default value ``both''.";
 152         }
 153 }
 154
 155 =item B<display_words>: I<NONE>
 156
 157 See L<display_lines>
 158
 159 =cut
 160
 161 if (get_config ('display_words'))
 162 {
 163         my $tmp = get_config ('display_words');
 164         $tmp = uc ($tmp);
 165
 166         if (($tmp eq 'NONE') or ($tmp eq 'BAR') or ($tmp eq 'NUMBER') or ($tmp eq 'BOTH'))
 167         {
 168                 $DISPLAY_WORDS = $tmp;
 169         }
 170         else
 171         {
 172                 $tmp = get_config ('display_words');
 173                 print STDERR $/, __FILE__, ": ``display_words'' has been set to the invalid value ``$tmp''. ",
 174                 $/, __FILE__, ": Valid values are ``none'', ``bar'', ``number'' and ``both''. Using default value ``none''.";
 175         }
 176 }
 177
 178 =item B<display_chars>: I<NONE>
 179
 180 See L<display_lines>
 181
 182 =cut
 183
 184 if (get_config ('display_chars'))
 185 {
 186         my $tmp = get_config ('display_chars');
 187         $tmp = uc ($tmp);
 188
 189         if (($tmp eq 'NONE') or ($tmp eq 'BAR') or ($tmp eq 'NUMBER') or ($tmp eq 'BOTH'))
 190         {
 191                 $DISPLAY_CHARS = $tmp;
 192         }
 193         else
 194         {
 195                 $tmp = get_config ('display_chars');
 196                 print STDERR $/, __FILE__, ": ``display_chars'' has been set to the invalid value ``$tmp''. ",
 197                 $/, __FILE__, ": Valid values are ``none'', ``bar'', ``number'' and ``both''. Using default value ``none''.";
 198         }
 199 }
 200
 201 =item B<display_times>: I<false>
 202
 203 Wether or not to display a fixed width bar that shows when a user is most
 204 active.
 205
 206 =cut
 207
 208 if (get_config ('display_times'))
 209 {
 210         my $tmp = get_config ('display_times');
 211
 212         if ($tmp =~ m/true|on|yes/i)
 213         {
 214                 $DISPLAY_TIMES = 1;
 215         }
 216         elsif ($tmp =~ m/false|off|no/i)
 217         {
 218                 $DISPLAY_TIMES = 0;
 219         }
 220         else
 221         {
 222                 print STDERR $/, __FILE__, ": ``display_times'' has been set to the invalid value ``$tmp''. ",
 223                 $/, __FILE__, ": Valid values are ``true'' and ``false''. Using default value ``false''.";
 224         }
 225 }
 226
 227 =item B<display_images>: I<false>
 228
 229 Wether or not to display images in the main ranking.
 230
 231 =cut
 232
 233 if (get_config ('display_images'))
 234 {
 235         my $tmp = get_config ('display_images');
 236
 237         if ($tmp =~ m/true|on|yes/i)
 238         {
 239                 $DISPLAY_IMAGES = 1;
 240         }
 241         elsif ($tmp =~ m/false|off|no/i)
 242         {
 243                 $DISPLAY_IMAGES = 0;
 244         }
 245         else
 246         {
 247                 print STDERR $/, __FILE__, ": ``display_times'' has been set to the invalid value ``$tmp''. ",
 248                 $/, __FILE__, ": Valid values are ``true'' and ``false''. Using default value ``false''.";
 249         }
 250 }
 251
 252 =item B<default_image>: I<http://www.url.org/image.png>
 253
 254 Sets the URL to the default image. This is included as-is in the HTML. You have
 255 to take care of (absolute) paths yourself.
 256
 257 =cut
 258
 259 if (get_config ('default_image'))
 260 {
 261         $DEFAULT_IMAGE = get_config ('default_image');
 262 }
 263
 264 =item B<sort_by>: I<LINES>
 265
 266 Sets by which field the output has to be sorted. This is completely independent
 267 from B<display_lines>, B<display_words> and B<display_chars>. Valid options are
 268 I<LINES>, I<WORDS> and I<CHARS>.
 269
 270 =cut
 271
 272 if (get_config ('sort_by'))
 273 {
 274         my $tmp = get_config ('sort_by');
 275         $tmp = uc ($tmp);
 276
 277         if (($tmp eq 'LINES') or ($tmp eq 'WORDS') or ($tmp eq 'CHARS'))
 278         {
 279                 $SORT_BY = $tmp;
 280         }
 281         else
 282         {
 283                 $tmp = get_config ('sort_by');
 284                 print STDERR $/, __FILE__, ": ``sort_by'' has been set to the invalid value ``$tmp''. ",
 285                 $/, __FILE__, ": Valid values are ``lines'' and ``words''. Using default value ``lines''.";
 286         }
 287 }
 288
 289 =item B<horizontal_images>: I<image1>, I<image2>, I<image3>, I<image4>
 290
 291 Sets the B<four> images used for horizontal bars/graphs. As above: You have to
 292 take care of correctness of paths yourself.
 293
 294 =cut
 295
 296 if (get_config ('horizontal_images'))
 297 {
 298         my @tmp = get_config ('horizontal_images');
 299         my $i;
 300
 301         if (scalar (@tmp) != 4)
 302         {
 303                 print STDERR $/, __FILE__, ": The number of horizontal images is not four. The output might look weird.", $/;
 304         }
 305
 306         for ($i = 0; $i < 4; $i++)
 307         {
 308                 if (!defined ($tmp[$i]))
 309                 {
 310                         next;
 311                 }
 312
 313                 $H_IMAGES[$i] = $tmp[$i];
 314         }
 315 }
 316
 317 =item B<bar_height>: I<130>
 318
 319 Sets the height (in pixels) of the highest vertical graph.
 320
 321 =cut
 322
 323 if (get_config ('bar_height'))
 324 {
 325         my $tmp = get_config ('bar_height');
 326         $tmp =~ s/\D//g;
 327         $BAR_HEIGHT = $tmp if ($tmp >= 10);
 328 }
 329
 330 =item B<bar_width>: I<100>
 331
 332 Sets the width (in pixels) of the widest horizontal graph.
 333
 334 =cut
 335
 336 if (get_config ('bar_width'))
 337 {
 338         my $tmp = get_config ('bar_width');
 339         $tmp =~ s/\D//g;
 340         $BAR_WIDTH = $tmp if ($tmp >= 10);
 341 }
 342
 343 =item B<longlines>: I<50>
 344
 345 Sets the number of rows of the main ranking table.
 346
 347 =cut
 348
 349 if (get_config ('longlines'))
 350 {
 351         my $tmp = get_config ('longlines');
 352         $tmp =~ s/\D//g;
 353         $LongLines = $tmp if ($tmp);
 354 }
 355
 356 =item B<shortlines>: I<10>
 357
 358 Sets the number of rows of the "they didn't write so much" table. There are six
 359 persons per line; you set the number of lines.
 360
 361 =over
 362
 363 =cut
 364
 365 if (get_config ('shortlines'))
 366 {
 367         my $tmp = get_config ('shortlines');
 368         $tmp =~ s/\D//g;
 369         if ($tmp or ($tmp == 0))
 370         {
 371                 $ShortLines = $tmp;
 372         }
 373 }
 374
 375 register_plugin ('TEXT', \&add);
 376 register_plugin ('ACTION', \&add);
 377 register_plugin ('OUTPUT', \&output);
 378
 379 my $VERSION = '$Id$';
 380 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
 381
 382 return (1);
 383
 384 sub add
 385 {
 386         my $data = shift;
 387
 388         my $nick = $data->{'nick'};
 389         my $ident = $data->{'ident'};
 390         my $hour = int ($data->{'hour'});
 391         my $host = $data->{'host'};
 392         my $text = $data->{'text'};
 393         my $type = $data->{'type'};
 394         my $time = $data->{'epoch'};
 395
 396         my $words = scalar (@{$data->{'words'}});
 397         my $chars = length ($text);
 398
 399         if ($type eq 'ACTION')
 400         {
 401                 $chars -= (length ($nick) + 3);
 402         }
 403
 404         my @counter = $NickLinesCounter->get ($nick);
 405         if (!@counter)
 406         {
 407                 @counter = qw(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0);
 408         }
 409         $counter[$hour]++;
 410         $NickLinesCounter->put ($nick, @counter);
 411
 412         @counter = $NickWordsCounter->get ($nick);
 413         if (!@counter)
 414         {
 415                 @counter = qw(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0);
 416         }
 417         $counter[$hour] += $words;
 418         $NickWordsCounter->put ($nick, @counter);
 419
 420         @counter = $NickCharsCounter->get ($nick);
 421         if (!@counter)
 422         {
 423                 @counter = qw(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0);
 424         }
 425         $counter[$hour] += $chars;
 426         $NickCharsCounter->put ($nick, @counter);
 427
 428         if ((length ($text) >= $QuoteMin)
 429                                 and (length ($text) <= $QuoteMax))
 430         {
 431                 my ($pointer) = $QuotePtr->get ($nick);
 432                 $pointer ||= 0;
 433
 434                 my $key = sprintf ("%s:%02i", $nick, $pointer);
 435
 436                 $QuoteCache->put ($key, $time, $text);
 437
 438                 $pointer = ($pointer + 1) % $QuoteCacheSize;
 439                 $QuotePtr->put ($nick, $pointer);
 440         }
 441         return (1);
 442 }
 443
 444 sub calculate
 445 {
 446         for (get_all_nicks ())
 447         {
 448                 my $nick = $_;
 449                 my $main = get_main_nick ($nick);
 450
 451                 if (!defined ($NickData->{$main}))
 452                 {
 453                         $NickData->{$main} =
 454                         {
 455                                 lines => [qw(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)],
 456                                 words => [qw(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)],
 457                                 chars => [qw(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)],
 458                                 lines_total => 0,
 459                                 words_total => 0,
 460                                 chars_total => 0
 461                         };
 462                 }
 463
 464                 my @counter = $NickLinesCounter->get ($nick);
 465                 if (@counter)
 466                 {
 467                         my $sum = 0;
 468                         for (my $i = 0; $i < 24; $i++)
 469                         {
 470                                 $NickData->{$main}{'lines'}[$i] += $counter[$i];
 471                                 $sum += $counter[$i];
 472                         }
 473                         $NickData->{$main}{'lines_total'} += $sum;
 474                 }
 475
 476                 @counter = $NickWordsCounter->get ($nick);
 477                 if (@counter)
 478                 {
 479                         my $sum = 0;
 480                         for (my $i = 0; $i < 24; $i++)
 481                         {
 482                                 $NickData->{$main}{'words'}[$i] += $counter[$i];
 483                                 $sum += $counter[$i];
 484                         }
 485                         $NickData->{$main}{'words_total'} += $sum;
 486                 }
 487
 488                 @counter = $NickCharsCounter->get ($nick);
 489                 if (@counter)
 490                 {
 491                         my $sum = 0;
 492                         for (my $i = 0; $i < 24; $i++)
 493                         {
 494                                 $NickData->{$main}{'chars'}[$i] += $counter[$i];
 495                                 $sum += $counter[$i];
 496                         }
 497                         $NickData->{$main}{'chars_total'} += $sum;
 498                 }
 499
 500                 if (!defined ($QuoteData->{$main}))
 501                 {
 502                         $QuoteData->{$main} = [];
 503                 }
 504         }
 505
 506         for ($QuoteCache->keys ())
 507         {
 508                 my $key = $_;
 509                 my ($nick, $num) = split (m/:/, $key);
 510                 my $main = get_main_nick ($nick);
 511
 512                 my ($epoch, $text) = $QuoteCache->get ($key);
 513                 die unless (defined ($text));
 514
 515                 if (!defined ($QuoteData->{$main}))
 516                 {
 517                         die;
 518                 }
 519                 elsif (scalar (@{$QuoteData->{$main}}) < $QuoteCacheSize)
 520                 {
 521                         push (@{$QuoteData->{$main}}, [$epoch, $text]);
 522                 }
 523                 else
 524                 {
 525                         my $insert = -1;
 526                         my $min = $epoch;
 527
 528                         for (my $i = 0; $i < $QuoteCacheSize; $i++)
 529                         {
 530                                 if ($QuoteData->{$main}[$i][0] < $min)
 531                                 {
 532                                         $insert = $i;
 533                                         $min = $QuoteData->{$main}[$i][0];
 534                                 }
 535                         }
 536
 537                         if ($insert != -1)
 538                         {
 539                                 $QuoteData->{$main}[$insert] = [$epoch, $text];
 540                         }
 541                 }
 542         }
 543 }
 544
 545 sub output
 546 {
 547         calculate ();
 548         activetimes ();
 549         ranking ();
 550 }
 551
 552 sub activetimes
 553 {
 554         my $max = 0;            # the most lines that were written in one hour..
 555         my $total = 0;          # the total amount of lines we wrote..
 556         my $factor = 0;         # used to find a bar's height
 557
 558         my @data = qw(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0);
 559
 560         my @img_urls = get_config ('vertical_images');
 561         if (!@img_urls)
 562         {
 563                 @img_urls = qw#images/ver0n.png images/ver1n.png images/ver2n.png images/ver3n.png#;
 564         }
 565
 566         my $fh = get_filehandle () or die;
 567
 568 # this for loop looks for the most amount of lines in one hour and sets
 569 # $most_lines
 570         for (keys %$NickData)
 571         {
 572                 my $nick = $_;
 573
 574                 for (my $i = 0; $i < 24; $i++)
 575                 {
 576                         $data[$i] += $NickData->{$nick}{'chars'}[$i];
 577                 }
 578         }
 579
 580         for (my $i = 0; $i < 24; $i++)
 581         {
 582                 $max = $data[$i] if ($max < $data[$i]);
 583                 $total += $data[$i];
 584         }
 585
 586         if (!$total)
 587         {
 588                 $total = 1;
 589                 $max = 1;
 590         }
 591
 592         $factor = (($BAR_HEIGHT - 1) / $max);
 593
 594         my $header = translate ('When do we actually talk here?');
 595         print $fh "<h2>$header</h2>\n",
 596         qq#<table class="hours">\n#,
 597         qq#  <tr class="bars">\n#;
 598
 599 # this for circles through the four colors. Each color represents six hours.
 600 # (4 * 6 hours = 24 hours)
 601         for (my $i = 0; $i <= 3; $i++)
 602         {
 603                 for (my $j = 0; $j < 6; $j++)
 604                 {
 605                         my $hour = (($i * 6) + $j);
 606                         if (!defined ($data[$hour]))
 607                         {
 608                                 $data[$hour] = 0;
 609                         }
 610
 611                         my $height  = sprintf ("%.2f", 95 * $data[$hour] / $max);
 612                         my $img = $img_urls[$i];
 613
 614                         print $fh qq#    <td class="bar vertical"><img src="$img" class="first last" style="height: $height\%;" alt="" /></td>\n#;
 615                 }
 616         }
 617         print $fh qq#  </tr>\n  <tr class="counter">\n#;
 618         for (my $i = 0; $i < 24; $i++)
 619         {
 620                 my $percent = sprintf ("%.1f", 100 * $data[$i] / $total);
 621                 print $fh qq#    <td class="counter">$percent\%</td>\n#;
 622         }
 623
 624         print $fh "  </tr>\n",
 625         qq#  <tr class="numeration">\n#;
 626         print $fh map { qq#    <td class="numeration">$_</td>\n# } (0 .. 23);
 627         print $fh "  </tr>\n",
 628         "</table>\n\n";
 629 }
 630
 631 sub ranking
 632 {
 633         my $count = 0;
 634
 635         my @nicks = keys (%$NickData);
 636
 637         return unless (@nicks);
 638
 639         my $max_lines = 1;
 640         my $max_words = 1;
 641         my $max_chars = 1;
 642
 643         my $linescount = 0;
 644
 645         my $fh = get_filehandle () or die;
 646
 647         my $sort_field = lc ($SORT_BY);
 648
 649         my $trans;
 650
 651         my $tmp;
 652         ($tmp) = sort { $NickData->{$b}{'lines_total'} <=> $NickData->{$a}{'lines_total'} } (@nicks);
 653         $max_lines = $NickData->{$tmp}{'lines_total'} || 0;
 654
 655         ($tmp) = sort { $NickData->{$b}{'words_total'} <=> $NickData->{$a}{'words_total'} } (@nicks);
 656         $max_words = $NickData->{$tmp}{'words_total'} || 0;
 657
 658         ($tmp) = sort { $NickData->{$b}{'chars_total'} <=> $NickData->{$a}{'chars_total'} } (@nicks);
 659         $max_chars = $NickData->{$tmp}{'chars_total'} || 0;
 660
 661         $trans = translate ('Most active nicks');
 662
 663         print $fh "<h2>$trans</h2>\n";
 664         if ($SORT_BY eq 'LINES')
 665         {
 666                 $trans = translate ('Nicks sorted by numbers of lines written');
 667         }
 668         elsif ($SORT_BY eq 'WORDS')
 669         {
 670                 $trans = translate ('Nicks sorted by numbers of words written');
 671         }
 672         else # ($SORT_BY eq 'CHARS')
 673         {
 674                 $trans = translate ('Nicks sorted by numbers of characters written');
 675         }
 676         print $fh "<p>($trans)</p>\n";
 677
 678         print $fh <<EOF;
 679
 680 <table class="big_ranking">
 681   <tr>
 682     <td class="invis">&nbsp;</td>
 683 EOF
 684         if ($DISPLAY_IMAGES)
 685         {
 686                 $trans = translate ('Image');
 687                 print $fh "    <th>$trans</th>\n";
 688         }
 689         #if (true)
 690         {
 691                 $trans = translate ('Nick');
 692                 print $fh "    <th>$trans</th>\n";
 693         }
 694         if ($DISPLAY_LINES ne 'NONE')
 695         {
 696                 $trans = translate ('Number of Lines');
 697                 print $fh "    <th>$trans</th>\n";
 698         }
 699         if ($DISPLAY_WORDS ne 'NONE')
 700         {
 701                 $trans = translate ('Number of Words');
 702                 print $fh "    <th>$trans</th>\n";
 703         }
 704         if ($DISPLAY_CHARS ne 'NONE')
 705         {
 706                 $trans = translate ('Number of Characters');
 707                 print $fh "    <th>$trans</th>\n";
 708         }
 709         if ($DISPLAY_TIMES)
 710         {
 711                 $trans = translate ('When?');
 712                 print $fh "    <th>$trans</th>\n";
 713         }
 714
 715         $trans = translate ('Random Quote');
 716         print $fh "    <th>$trans</th>\n",
 717         "  </tr>\n";
 718
 719         @$SortedNicklist = sort
 720         {
 721                 $NickData->{$b}{"${sort_field}_total"} <=> $NickData->{$a}{"${sort_field}_total"}
 722         } (@nicks);
 723
 724         @nicks = ();
 725
 726         for (@$SortedNicklist)
 727         {
 728                 my $nick = $_;
 729                 my $ident = nick_to_ident ($nick);
 730                 my $name  = chatter_to_name ("$nick!$ident");
 731                 my $print = $name || $nick;
 732
 733                 $linescount++;
 734
 735                 # As long as we didn't hit the
 736                 # $LongLines-limit we continue
 737                 # our table..
 738                 if ($linescount <= $LongLines)
 739                 {
 740                         $NicksInMainTable->{$nick} = $linescount;
 741
 742                         my $quote = translate ('-- no quote available --');
 743
 744                         if (@{$QuoteData->{$nick}})
 745                         {
 746                                 my $num = scalar (@{$QuoteData->{$nick}});
 747                                 my $rand = int (rand ($num));
 748
 749                                 $quote = html_escape ($QuoteData->{$nick}[$rand][1]);
 750                         }
 751
 752                         my $link = '';
 753                         my $image = '';
 754                         my $realname = '';
 755                         if ($name)
 756                         {
 757                                 $link     = get_link ($name);
 758                                 $image    = get_image ($name);
 759                                 $realname = get_realname ($name);
 760                         }
 761
 762                         print $fh "  <tr>\n",
 763                         qq#    <td class="numeration"># . $linescount . "</td>\n";
 764
 765                         if ($DISPLAY_IMAGES)
 766                         {
 767                                 if ($DEFAULT_IMAGE and !$image)
 768                                 {
 769                                         $image = $DEFAULT_IMAGE;
 770                                 }
 771
 772                                 print $fh qq#    <td class="image">#;
 773                                 if ($image)
 774                                 {
 775                                         if ($link)
 776                                         {
 777                                                 print $fh qq#<a href="$link">#;
 778                                         }
 779                                         print $fh qq#<img src="$image" alt="$name" />#;
 780                                         if ($link)
 781                                         {
 782                                                 print $fh "</a>";
 783                                         }
 784                                 }
 785                                 else
 786                                 {
 787                                         print $fh '&nbsp;';
 788                                 }
 789                                 print $fh "</td>\n";
 790                         }
 791
 792                         my $title = $realname;
 793                         if (!$title)
 794                         {
 795                                 $title = "User: $name; " if ($name);
 796                                 $title .= "Ident: $ident";
 797                         }
 798                         print $fh qq#    <td class="nick" title="$title">#;
 799
 800                         if ($link)
 801                         {
 802                                 print $fh qq#<a href="$link">$print</a></td>\n#
 803                         }
 804                         else
 805                         {
 806                                 print $fh qq#$print</td>\n#;
 807                         }
 808
 809                         if ($DISPLAY_LINES ne 'NONE')
 810                         {
 811                                 print $fh qq#    <td class="bar">#;
 812                                 if (($DISPLAY_LINES eq 'BOTH') or ($DISPLAY_LINES eq 'BAR'))
 813                                 {
 814                                         my $code = bar ($max_lines, $NickData->{$nick}{'lines'});
 815                                         print $fh $code;
 816                                 }
 817                                 print $fh '&nbsp;' if ($DISPLAY_LINES eq 'BOTH');
 818                                 if (($DISPLAY_LINES eq 'BOTH') or ($DISPLAY_LINES eq 'NUMBER'))
 819                                 {
 820                                         print $fh $NickData->{$nick}{'lines_total'};
 821                                 }
 822                                 print $fh "</td>\n";
 823                         }
 824
 825                         if ($DISPLAY_WORDS ne 'NONE')
 826                         {
 827                                 print $fh qq#    <td class="bar">#;
 828                                 if (($DISPLAY_WORDS eq 'BOTH') or ($DISPLAY_WORDS eq 'BAR'))
 829                                 {
 830                                         my $code = bar ($max_words, $NickData->{$nick}{'words'});
 831                                         print $fh $code;
 832                                 }
 833                                 print $fh '&nbsp;' if ($DISPLAY_WORDS eq 'BOTH');
 834                                 if (($DISPLAY_WORDS eq 'BOTH') or ($DISPLAY_WORDS eq 'NUMBER'))
 835                                 {
 836                                         print $fh $NickData->{$nick}{'words_total'};
 837                                 }
 838                                 print $fh "</td>\n";
 839                         }
 840
 841                         if ($DISPLAY_CHARS ne 'NONE')
 842                         {
 843                                 print $fh qq#    <td class="bar">#;
 844                                 if (($DISPLAY_CHARS eq 'BOTH') or ($DISPLAY_CHARS eq 'BAR'))
 845                                 {
 846                                         my $code = bar ($max_chars, $NickData->{$nick}{'chars'});
 847                                         print $fh $code;
 848                                 }
 849                                 print $fh '&nbsp;' if ($DISPLAY_CHARS eq 'BOTH');
 850                                 if (($DISPLAY_CHARS eq 'BOTH') or ($DISPLAY_CHARS eq 'NUMBER'))
 851                                 {
 852                                         print $fh $NickData->{$nick}{'chars_total'};
 853                                 }
 854                                 print $fh "</td>\n";
 855                         }
 856
 857                         if ($DISPLAY_TIMES)
 858                         {
 859                                 my $code = bar ($NickData->{$nick}{'chars_total'}, $NickData->{$nick}{'chars'});
 860                                 print $fh qq#    <td class="bar">$code</td>\n#;
 861                         }
 862
 863                         print $fh qq#    <td class="quote">$quote</td>\n#,
 864                         qq#  </tr>\n#;
 865
 866                         if ($linescount == $LongLines)
 867                         {
 868                                 print $fh "</table>\n\n";
 869                         }
 870                 }
 871
 872                 # Ok, we have too many people to
 873                 # list them all so we start a
 874                 # smaller table and just list the
 875                 # names.. (Six names per line..)
 876                 elsif ($linescount <= ($LongLines + 6 * $ShortLines))
 877                 {
 878                         my $row_in_this_table = int (($linescount - $LongLines - 1) / 6);
 879                         my $col_in_this_table = ($linescount - $LongLines - 1) % 6;
 880
 881                         my $total = 0;
 882                         if ($SORT_BY eq 'LINES')
 883                         {
 884                                 $total = $NickData->{$nick}{'lines_total'};
 885                         }
 886                         elsif ($SORT_BY eq 'WORDS')
 887                         {
 888                                 $total = $NickData->{$nick}{'words_total'};
 889                         }
 890                         else # ($SORT_BY eq 'CHARS')
 891                         {
 892                                 $total = $NickData->{$nick}{'chars_total'};
 893                         }
 894
 895                         my $title = $name ? get_realname ($name) : '';
 896                         if (!$title)
 897                         {
 898                                 $title = "User: $name; " if ($name);
 899                                 $title .= "Ident: $ident";
 900                         }
 901
 902                         if ($row_in_this_table == 0 and $col_in_this_table == 0)
 903                         {
 904                                 $trans = translate ("They didn't write so much");
 905                                 print $fh "<h2>$trans</h2>\n",
 906                                 qq#<table class="small_ranking">\n#,
 907                                 qq#  <tr>\n#;
 908                         }
 909
 910                         if ($col_in_this_table == 0 and $row_in_this_table != 0)
 911                         {
 912                                 print $fh "  </tr>\n",
 913                                 qq#  <tr>\n#;
 914                         }
 915
 916                         print $fh qq#    <td title="$title">$print ($total)</td>\n#;
 917
 918                         if ($row_in_this_table == $ShortLines and $col_in_this_table == 5)
 919                         {
 920                                 print $fh "  </tr>\n",
 921                                 qq#</table>\n\n#;
 922                         }
 923                 }
 924
 925                 # There is no else. There are
 926                 # just too many people around.
 927                 # I might add a "There are xyz
 928                 # unmentioned nicks"-line..
 929         }
 930
 931         if (($linescount > $LongLines)
 932                         and ($linescount <= ($LongLines + 6 * $ShortLines)))
 933         {
 934                 my $col = ($linescount - $LongLines - 1) % 6;
 935
 936                 while ($col < 5)
 937                 {
 938                         print $fh qq#    <td>&nbsp;</td>\n#;
 939                         $col++;
 940                 }
 941
 942                 print $fh "  </tr>\n";
 943         }
 944
 945         if ($linescount != $LongLines)
 946         {
 947                 print $fh "</table>\n\n";
 948         }
 949 }
 950
 951 # this is called by "&ranking ();" and prints the horizontal usage-bar in the
 952 # detailed nick-table
 953 sub bar
 954 {
 955         my $max_num = shift;
 956         my $source = shift;
 957
 958         confess () unless (ref ($source) eq 'ARRAY');
 959
 960         # BAR_WIDTH is a least 10
 961         my $max_width = $BAR_WIDTH - 4;
 962         my $factor = 1;
 963         my $retval = '';
 964
 965         my $i;
 966         my $j;
 967
 968         if (!$max_num) { return ($retval); }
 969         $factor = $max_width / $max_num;
 970
 971         for ($i = 0; $i < 4; $i++)
 972         {
 973                 my $sum = 0;
 974                 my $width = 1;
 975                 my $img = $H_IMAGES[$i];
 976
 977                 for ($j = 0; $j < 6; $j++)
 978                 {
 979                         my $hour = ($i * 6) + $j;
 980                         $sum += $source->[$hour];
 981                 }
 982
 983                 $width += int (0.5 + ($sum * $factor));
 984
 985                 $retval .= qq#<img src="$img" style="width: # . $width . q#px"#;
 986                 if ($i == 0) { $retval .= qq# class="first"#; }
 987                 elsif ($i == 3) { $retval .= qq# class="last"#; }
 988                 $retval .= qq( alt="$sum" />);
 989         }
 990
 991         return ($retval);
 992 }
 993
 994 =head1 EXPORTED FUNCTIONS
 995
 996 =over 4
 997
 998 =item B<get_core_nick_counters> (I<$nick>)
 999
1000 Returns a hash-ref that containes all the nick-counters available. It looks
1001 like this:
1002
1003     {
1004         lines => [qw(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)],
1005         words => [qw(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)],
1006         chars => [qw(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)],
1007         lines_total => 0,
1008         words_total => 0,
1009         chars_total => 0
1010     }
1011
1012 =cut
1013
1014 sub get_core_nick_counters
1015 {
1016         my $nick = shift;
1017
1018         if (!defined ($NickData->{$nick}))
1019         {
1020                 return ({});
1021         }
1022
1023         return ($NickData->{$nick});
1024 }
1025
1026 =item B<get_sorted_nicklist> ()
1027
1028 Returns an array-ref that containes all nicks, sorted by the field given in the
1029 config-file.
1030
1031 =cut
1032
1033 sub get_sorted_nicklist
1034 {
1035         return ($SortedNicklist);
1036 }
1037
1038 =item B<nick_is_in_main_table> (I<$nick>)
1039
1040 Returns the position of the nick in the main table or zero if it is not in the
1041 main table.
1042
1043 =cut
1044
1045 sub nick_is_in_main_table
1046 {
1047         my $nick = shift;
1048
1049         return (defined ($NicksInMainTable->{$nick}) ? $NicksInMainTable->{$nick} : 0);
1050 }
1051
1052 =back
1053
1054 =head1 AUTHOR
1055
1056 Florian octo Forster E<lt>octo at verplant.orgE<gt>
1057
1058 =cut