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