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                 my $span = $DISPLAY_LINES eq 'BOTH' ? ' colspan="2"' : '';
 697                 $trans = translate ('Number of Lines');
 698                 print $fh "    <th$span>$trans</th>\n";
 699         }
 700         if ($DISPLAY_WORDS ne 'NONE')
 701         {
 702                 my $span = $DISPLAY_WORDS eq 'BOTH' ? ' colspan="2"' : '';
 703                 $trans = translate ('Number of Words');
 704                 print $fh "    <th$span>$trans</th>\n";
 705         }
 706         if ($DISPLAY_CHARS ne 'NONE')
 707         {
 708                 my $span = $DISPLAY_CHARS eq 'BOTH' ? ' colspan="2"' : '';
 709                 $trans = translate ('Number of Characters');
 710                 print $fh "    <th$span>$trans</th>\n";
 711         }
 712         if ($DISPLAY_TIMES)
 713         {
 714                 $trans = translate ('When?');
 715                 print $fh "    <th>$trans</th>\n";
 716         }
 717
 718         $trans = translate ('Random Quote');
 719         print $fh "    <th>$trans</th>\n",
 720         "  </tr>\n";
 721
 722         @$SortedNicklist = sort
 723         {
 724                 $NickData->{$b}{"${sort_field}_total"} <=> $NickData->{$a}{"${sort_field}_total"}
 725         } (@nicks);
 726
 727         @nicks = ();
 728
 729         for (@$SortedNicklist)
 730         {
 731                 my $nick = $_;
 732                 my $ident = nick_to_ident ($nick);
 733                 my $name  = chatter_to_name ("$nick!$ident");
 734                 my $print = $name || $nick;
 735
 736                 $linescount++;
 737
 738                 # As long as we didn't hit the
 739                 # $LongLines-limit we continue
 740                 # our table..
 741                 if ($linescount <= $LongLines)
 742                 {
 743                         $NicksInMainTable->{$nick} = $linescount;
 744
 745                         my $quote = translate ('-- no quote available --');
 746
 747                         if (@{$QuoteData->{$nick}})
 748                         {
 749                                 my $num = scalar (@{$QuoteData->{$nick}});
 750                                 my $rand = int (rand ($num));
 751
 752                                 $quote = html_escape ($QuoteData->{$nick}[$rand][1]);
 753                         }
 754
 755                         my $link = '';
 756                         my $image = '';
 757                         my $realname = '';
 758                         if ($name)
 759                         {
 760                                 $link     = get_link ($name);
 761                                 $image    = get_image ($name);
 762                                 $realname = get_realname ($name);
 763                         }
 764
 765                         print $fh "  <tr>\n",
 766                         qq#    <td class="numeration"># . $linescount . "</td>\n";
 767
 768                         if ($DISPLAY_IMAGES)
 769                         {
 770                                 if ($DEFAULT_IMAGE and !$image)
 771                                 {
 772                                         $image = $DEFAULT_IMAGE;
 773                                 }
 774
 775                                 print $fh qq#    <td class="image">#;
 776                                 if ($image)
 777                                 {
 778                                         if ($link)
 779                                         {
 780                                                 print $fh qq#<a href="$link">#;
 781                                         }
 782                                         print $fh qq#<img src="$image" alt="$name" />#;
 783                                         if ($link)
 784                                         {
 785                                                 print $fh "</a>";
 786                                         }
 787                                 }
 788                                 else
 789                                 {
 790                                         print $fh '&nbsp;';
 791                                 }
 792                                 print $fh "</td>\n";
 793                         }
 794
 795                         my $title = $realname;
 796                         if (!$title)
 797                         {
 798                                 $title = "User: $name; " if ($name);
 799                                 $title .= "Ident: $ident";
 800                         }
 801                         print $fh qq#    <td class="nick" title="$title">#;
 802
 803                         if ($link)
 804                         {
 805                                 print $fh qq#<a href="$link">$print</a></td>\n#
 806                         }
 807                         else
 808                         {
 809                                 print $fh qq#$print</td>\n#;
 810                         }
 811
 812                         if ($DISPLAY_LINES ne 'NONE')
 813                         {
 814                                 if (($DISPLAY_LINES eq 'BOTH') or ($DISPLAY_LINES eq 'NUMBER'))
 815                                 {
 816                                         my $num = $NickData->{$nick}{'lines_total'};
 817                                         print $fh qq(    <td class="counter">$num</td>\n);
 818                                 }
 819                                 if (($DISPLAY_LINES eq 'BOTH') or ($DISPLAY_LINES eq 'BAR'))
 820                                 {
 821                                         my $code = bar ($max_lines, $NickData->{$nick}{'lines'});
 822                                         print $fh qq(    <td class="bar horizontal">$code</td>\n);
 823                                 }
 824                         }
 825
 826                         if ($DISPLAY_WORDS ne 'NONE')
 827                         {
 828                                 if (($DISPLAY_WORDS eq 'BOTH') or ($DISPLAY_WORDS eq 'NUMBER'))
 829                                 {
 830                                         my $num = $NickData->{$nick}{'words_total'};
 831                                         print $fh qq(    <td class="counter">$num</td>\n);
 832                                 }
 833                                 if (($DISPLAY_WORDS eq 'BOTH') or ($DISPLAY_WORDS eq 'BAR'))
 834                                 {
 835                                         my $code = bar ($max_words, $NickData->{$nick}{'words'});
 836                                         print $fh qq(    <td class="bar horizontal">$code</td>\n);
 837                                 }
 838                         }
 839
 840                         if ($DISPLAY_CHARS ne 'NONE')
 841                         {
 842                                 if (($DISPLAY_CHARS eq 'BOTH') or ($DISPLAY_CHARS eq 'NUMBER'))
 843                                 {
 844                                         my $num = $NickData->{$nick}{'chars_total'};
 845                                         print $fh qq(    <td class="counter">$num</td>\n);
 846                                 }
 847                                 if (($DISPLAY_CHARS eq 'BOTH') or ($DISPLAY_CHARS eq 'BAR'))
 848                                 {
 849                                         my $code = bar ($max_chars, $NickData->{$nick}{'chars'});
 850                                         print $fh qq(    <td class="bar horizontal">$code</td>\n);
 851                                 }
 852                         }
 853
 854                         if ($DISPLAY_TIMES)
 855                         {
 856                                 my $code = bar ($NickData->{$nick}{'chars_total'}, $NickData->{$nick}{'chars'});
 857                                 print $fh qq#    <td class="bar">$code</td>\n#;
 858                         }
 859
 860                         print $fh qq#    <td class="quote">$quote</td>\n#,
 861                         qq#  </tr>\n#;
 862
 863                         if ($linescount == $LongLines)
 864                         {
 865                                 print $fh "</table>\n\n";
 866                         }
 867                 }
 868
 869                 # Ok, we have too many people to
 870                 # list them all so we start a
 871                 # smaller table and just list the
 872                 # names.. (Six names per line..)
 873                 elsif ($linescount <= ($LongLines + 6 * $ShortLines))
 874                 {
 875                         my $row_in_this_table = int (($linescount - $LongLines - 1) / 6);
 876                         my $col_in_this_table = ($linescount - $LongLines - 1) % 6;
 877
 878                         my $total = 0;
 879                         if ($SORT_BY eq 'LINES')
 880                         {
 881                                 $total = $NickData->{$nick}{'lines_total'};
 882                         }
 883                         elsif ($SORT_BY eq 'WORDS')
 884                         {
 885                                 $total = $NickData->{$nick}{'words_total'};
 886                         }
 887                         else # ($SORT_BY eq 'CHARS')
 888                         {
 889                                 $total = $NickData->{$nick}{'chars_total'};
 890                         }
 891
 892                         my $title = $name ? get_realname ($name) : '';
 893                         if (!$title)
 894                         {
 895                                 $title = "User: $name; " if ($name);
 896                                 $title .= "Ident: $ident";
 897                         }
 898
 899                         if ($row_in_this_table == 0 and $col_in_this_table == 0)
 900                         {
 901                                 $trans = translate ("They didn't write so much");
 902                                 print $fh "<h2>$trans</h2>\n",
 903                                 qq#<table class="small_ranking">\n#,
 904                                 qq#  <tr>\n#;
 905                         }
 906
 907                         if ($col_in_this_table == 0 and $row_in_this_table != 0)
 908                         {
 909                                 print $fh "  </tr>\n",
 910                                 qq#  <tr>\n#;
 911                         }
 912
 913                         print $fh qq#    <td title="$title">$print ($total)</td>\n#;
 914
 915                         if ($row_in_this_table == $ShortLines and $col_in_this_table == 5)
 916                         {
 917                                 print $fh "  </tr>\n",
 918                                 qq#</table>\n\n#;
 919                         }
 920                 }
 921
 922                 # There is no else. There are
 923                 # just too many people around.
 924                 # I might add a "There are xyz
 925                 # unmentioned nicks"-line..
 926         }
 927
 928         if (($linescount > $LongLines)
 929                         and ($linescount <= ($LongLines + 6 * $ShortLines)))
 930         {
 931                 my $col = ($linescount - $LongLines - 1) % 6;
 932
 933                 while ($col < 5)
 934                 {
 935                         print $fh qq#    <td>&nbsp;</td>\n#;
 936                         $col++;
 937                 }
 938
 939                 print $fh "  </tr>\n";
 940         }
 941
 942         if ($linescount != $LongLines)
 943         {
 944                 print $fh "</table>\n\n";
 945         }
 946 }
 947
 948 # this is called by "&ranking ();" and prints the horizontal usage-bar in the
 949 # detailed nick-table
 950 sub bar
 951 {
 952         my $max_num = shift;
 953         my $source = shift;
 954
 955         confess () unless (ref ($source) eq 'ARRAY');
 956
 957         # BAR_WIDTH is a least 10
 958         my $retval = '';
 959
 960         my $i;
 961         my $j;
 962
 963         for ($i = 0; $i < 4; $i++)
 964         {
 965                 my $sum = 0;
 966                 my $img = $H_IMAGES[$i];
 967                 my $width;
 968
 969                 for ($j = 0; $j < 6; $j++)
 970                 {
 971                         my $hour = ($i * 6) + $j;
 972                         $sum += $source->[$hour];
 973                 }
 974
 975                 $width = sprintf ("%.2f", 95 * $sum / $max_num);
 976
 977                 $retval .= qq#<img src="$img" style="width: $width%;"#;
 978                 if ($i == 0) { $retval .= qq# class="first"#; }
 979                 elsif ($i == 3) { $retval .= qq# class="last"#; }
 980                 $retval .= qq( alt="$sum" />);
 981         }
 982
 983         return ($retval);
 984 }
 985
 986 =head1 EXPORTED FUNCTIONS
 987
 988 =over 4
 989
 990 =item B<get_core_nick_counters> (I<$nick>)
 991
 992 Returns a hash-ref that containes all the nick-counters available. It looks
 993 like this:
 994
 995     {
 996         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)],
 997         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)],
 998         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)],
 999         lines_total => 0,
1000         words_total => 0,
1001         chars_total => 0
1002     }
1003
1004 =cut
1005
1006 sub get_core_nick_counters
1007 {
1008         my $nick = shift;
1009
1010         if (!defined ($NickData->{$nick}))
1011         {
1012                 return ({});
1013         }
1014
1015         return ($NickData->{$nick});
1016 }
1017
1018 =item B<get_sorted_nicklist> ()
1019
1020 Returns an array-ref that containes all nicks, sorted by the field given in the
1021 config-file.
1022
1023 =cut
1024
1025 sub get_sorted_nicklist
1026 {
1027         return ($SortedNicklist);
1028 }
1029
1030 =item B<nick_is_in_main_table> (I<$nick>)
1031
1032 Returns the position of the nick in the main table or zero if it is not in the
1033 main table.
1034
1035 =cut
1036
1037 sub nick_is_in_main_table
1038 {
1039         my $nick = shift;
1040
1041         return (defined ($NicksInMainTable->{$nick}) ? $NicksInMainTable->{$nick} : 0);
1042 }
1043
1044 =back
1045
1046 =head1 AUTHOR
1047
1048 Florian octo Forster E<lt>octo at verplant.orgE<gt>
1049
1050 =cut