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">\n#,
 595         qq#  <tr class="bars">\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 < 6; $j++)
 602                 {
 603                         my $hour = (($i * 6) + $j);
 604                         if (!defined ($data[$hour]))
 605                         {
 606                                 $data[$hour] = 0;
 607                         }
 608
 609                         my $height  = sprintf ("%.2f", 95 * $data[$hour] / $max);
 610                         my $img = $img_urls[$i];
 611
 612                         print $fh qq#    <td class="bar vertical"><img src="$img" class="first last" style="height: $height\%;" alt="" /></td>\n#;
 613                 }
 614         }
 615         print $fh qq#  </tr>\n  <tr class="counter">\n#;
 616         for (my $i = 0; $i < 24; $i++)
 617         {
 618                 my $percent = sprintf ("%.1f", 100 * $data[$i] / $total);
 619                 print $fh qq#    <td class="counter">$percent\%</td>\n#;
 620         }
 621
 622         print $fh "  </tr>\n",
 623         qq#  <tr class="numeration">\n#;
 624         print $fh map { qq#    <td class="numeration">$_</td>\n# } (0 .. 23);
 625         print $fh "  </tr>\n",
 626         "</table>\n\n";
 627 }
 628
 629 sub ranking
 630 {
 631         my $count = 0;
 632
 633         my @nicks = keys (%$NickData);
 634
 635         return unless (@nicks);
 636
 637         my $max_lines = 1;
 638         my $max_words = 1;
 639         my $max_chars = 1;
 640
 641         my $linescount = 0;
 642
 643         my $fh = get_filehandle () or die;
 644
 645         my $sort_field = lc ($SORT_BY);
 646
 647         my $trans;
 648
 649         my $tmp;
 650         ($tmp) = sort { $NickData->{$b}{'lines_total'} <=> $NickData->{$a}{'lines_total'} } (@nicks);
 651         $max_lines = $NickData->{$tmp}{'lines_total'} || 0;
 652
 653         ($tmp) = sort { $NickData->{$b}{'words_total'} <=> $NickData->{$a}{'words_total'} } (@nicks);
 654         $max_words = $NickData->{$tmp}{'words_total'} || 0;
 655
 656         ($tmp) = sort { $NickData->{$b}{'chars_total'} <=> $NickData->{$a}{'chars_total'} } (@nicks);
 657         $max_chars = $NickData->{$tmp}{'chars_total'} || 0;
 658
 659         $trans = translate ('Most active nicks');
 660
 661         print $fh "<h2>$trans</h2>\n";
 662         if ($SORT_BY eq 'LINES')
 663         {
 664                 $trans = translate ('Nicks sorted by numbers of lines written');
 665         }
 666         elsif ($SORT_BY eq 'WORDS')
 667         {
 668                 $trans = translate ('Nicks sorted by numbers of words written');
 669         }
 670         else # ($SORT_BY eq 'CHARS')
 671         {
 672                 $trans = translate ('Nicks sorted by numbers of characters written');
 673         }
 674         print $fh "<p>($trans)</p>\n";
 675
 676         print $fh <<EOF;
 677
 678 <table class="big_ranking">
 679   <tr>
 680     <td class="invis">&nbsp;</td>
 681 EOF
 682         if ($DISPLAY_IMAGES)
 683         {
 684                 $trans = translate ('Image');
 685                 print $fh "    <th>$trans</th>\n";
 686         }
 687         #if (true)
 688         {
 689                 $trans = translate ('Nick');
 690                 print $fh "    <th>$trans</th>\n";
 691         }
 692         if ($DISPLAY_LINES ne 'NONE')
 693         {
 694                 $trans = translate ('Number of Lines');
 695                 print $fh "    <th>$trans</th>\n";
 696         }
 697         if ($DISPLAY_WORDS ne 'NONE')
 698         {
 699                 $trans = translate ('Number of Words');
 700                 print $fh "    <th>$trans</th>\n";
 701         }
 702         if ($DISPLAY_CHARS ne 'NONE')
 703         {
 704                 $trans = translate ('Number of Characters');
 705                 print $fh "    <th>$trans</th>\n";
 706         }
 707         if ($DISPLAY_TIMES)
 708         {
 709                 $trans = translate ('When?');
 710                 print $fh "    <th>$trans</th>\n";
 711         }
 712
 713         $trans = translate ('Random Quote');
 714         print $fh "    <th>$trans</th>\n",
 715         "  </tr>\n";
 716
 717         @$SortedNicklist = sort
 718         {
 719                 $NickData->{$b}{"${sort_field}_total"} <=> $NickData->{$a}{"${sort_field}_total"}
 720         } (@nicks);
 721
 722         @nicks = ();
 723
 724         for (@$SortedNicklist)
 725         {
 726                 my $nick = $_;
 727                 my $ident = nick_to_ident ($nick);
 728                 my $name  = ident_to_name ($ident);
 729                 my $print = $name || $nick;
 730
 731                 $linescount++;
 732
 733                 # As long as we didn't hit the
 734                 # $LongLines-limit we continue
 735                 # our table..
 736                 if ($linescount <= $LongLines)
 737                 {
 738                         my $quote = translate ('-- no quote available --');
 739
 740                         if (@{$QuoteData->{$nick}})
 741                         {
 742                                 my $num = scalar (@{$QuoteData->{$nick}});
 743                                 my $rand = int (rand ($num));
 744
 745                                 $quote = html_escape ($QuoteData->{$nick}[$rand][1]);
 746                         }
 747
 748                         my $link = '';
 749                         my $image = '';
 750                         my $realname = '';
 751                         if ($name)
 752                         {
 753                                 $link     = get_link ($name);
 754                                 $image    = get_image ($name);
 755                                 $realname = get_realname ($name);
 756                         }
 757
 758                         print $fh "  <tr>\n",
 759                         qq#    <td class="numeration"># . $linescount . "</td>\n";
 760
 761                         if ($DISPLAY_IMAGES)
 762                         {
 763                                 if ($DEFAULT_IMAGE and !$image)
 764                                 {
 765                                         $image = $DEFAULT_IMAGE;
 766                                 }
 767
 768                                 print $fh qq#    <td class="image">#;
 769                                 if ($image)
 770                                 {
 771                                         if ($link)
 772                                         {
 773                                                 print $fh qq#<a href="$link">#;
 774                                         }
 775                                         print $fh qq#<img src="$image" alt="$name" />#;
 776                                         if ($link)
 777                                         {
 778                                                 print $fh "</a>";
 779                                         }
 780                                 }
 781                                 else
 782                                 {
 783                                         print $fh '&nbsp;';
 784                                 }
 785                                 print $fh "</td>\n";
 786                         }
 787
 788                         my $title = $realname;
 789                         if (!$title)
 790                         {
 791                                 $title = "User: $name; " if ($name);
 792                                 $title .= "Ident: $ident";
 793                         }
 794                         print $fh qq#    <td class="nick" title="$title">#;
 795
 796                         if ($link)
 797                         {
 798                                 print $fh qq#<a href="$link">$print</a></td>\n#
 799                         }
 800                         else
 801                         {
 802                                 print $fh qq#$print</td>\n#;
 803                         }
 804
 805                         if ($DISPLAY_LINES ne 'NONE')
 806                         {
 807                                 print $fh qq#    <td class="bar">#;
 808                                 if (($DISPLAY_LINES eq 'BOTH') or ($DISPLAY_LINES eq 'BAR'))
 809                                 {
 810                                         my $code = bar ($max_lines, $NickData->{$nick}{'lines'});
 811                                         print $fh $code;
 812                                 }
 813                                 print $fh '&nbsp;' if ($DISPLAY_LINES eq 'BOTH');
 814                                 if (($DISPLAY_LINES eq 'BOTH') or ($DISPLAY_LINES eq 'NUMBER'))
 815                                 {
 816                                         print $fh $NickData->{$nick}{'lines_total'};
 817                                 }
 818                                 print $fh "</td>\n";
 819                         }
 820
 821                         if ($DISPLAY_WORDS ne 'NONE')
 822                         {
 823                                 print $fh qq#    <td class="bar">#;
 824                                 if (($DISPLAY_WORDS eq 'BOTH') or ($DISPLAY_WORDS eq 'BAR'))
 825                                 {
 826                                         my $code = bar ($max_words, $NickData->{$nick}{'words'});
 827                                         print $fh $code;
 828                                 }
 829                                 print $fh '&nbsp;' if ($DISPLAY_WORDS eq 'BOTH');
 830                                 if (($DISPLAY_WORDS eq 'BOTH') or ($DISPLAY_WORDS eq 'NUMBER'))
 831                                 {
 832                                         print $fh $NickData->{$nick}{'words_total'};
 833                                 }
 834                                 print $fh "</td>\n";
 835                         }
 836
 837                         if ($DISPLAY_CHARS ne 'NONE')
 838                         {
 839                                 print $fh qq#    <td class="bar">#;
 840                                 if (($DISPLAY_CHARS eq 'BOTH') or ($DISPLAY_CHARS eq 'BAR'))
 841                                 {
 842                                         my $code = bar ($max_chars, $NickData->{$nick}{'chars'});
 843                                         print $fh $code;
 844                                 }
 845                                 print $fh '&nbsp;' if ($DISPLAY_CHARS eq 'BOTH');
 846                                 if (($DISPLAY_CHARS eq 'BOTH') or ($DISPLAY_CHARS eq 'NUMBER'))
 847                                 {
 848                                         print $fh $NickData->{$nick}{'chars_total'};
 849                                 }
 850                                 print $fh "</td>\n";
 851                         }
 852
 853                         if ($DISPLAY_TIMES)
 854                         {
 855                                 my $code = bar ($NickData->{$nick}{'chars_total'}, $NickData->{$nick}{'chars'});
 856                                 print $fh qq#    <td class="bar">$code</td>\n#;
 857                         }
 858
 859                         print $fh qq#    <td class="quote">$quote</td>\n#,
 860                         qq#  </tr>\n#;
 861
 862                         if ($linescount == $LongLines)
 863                         {
 864                                 print $fh "</table>\n\n";
 865                         }
 866                 }
 867
 868                 # Ok, we have too many people to
 869                 # list them all so we start a
 870                 # smaller table and just list the
 871                 # names.. (Six names per line..)
 872                 elsif ($linescount <= ($LongLines + 6 * $ShortLines))
 873                 {
 874                         my $row_in_this_table = int (($linescount - $LongLines - 1) / 6);
 875                         my $col_in_this_table = ($linescount - $LongLines - 1) % 6;
 876
 877                         my $total = 0;
 878                         if ($SORT_BY eq 'LINES')
 879                         {
 880                                 $total = $NickData->{$nick}{'lines_total'};
 881                         }
 882                         elsif ($SORT_BY eq 'WORDS')
 883                         {
 884                                 $total = $NickData->{$nick}{'words_total'};
 885                         }
 886                         else # ($SORT_BY eq 'CHARS')
 887                         {
 888                                 $total = $NickData->{$nick}{'chars_total'};
 889                         }
 890
 891                         my $title = $name ? get_realname ($name) : '';
 892                         if (!$title)
 893                         {
 894                                 $title = "User: $name; " if ($name);
 895                                 $title .= "Ident: $ident";
 896                         }
 897
 898                         if ($row_in_this_table == 0 and $col_in_this_table == 0)
 899                         {
 900                                 $trans = translate ("They didn't write so much");
 901                                 print $fh "<h2>$trans</h2>\n",
 902                                 qq#<table class="small_ranking">\n#,
 903                                 qq#  <tr>\n#;
 904                         }
 905
 906                         if ($col_in_this_table == 0 and $row_in_this_table != 0)
 907                         {
 908                                 print $fh "  </tr>\n",
 909                                 qq#  <tr>\n#;
 910                         }
 911
 912                         print $fh qq#    <td title="$title">$print ($total)</td>\n#;
 913
 914                         if ($row_in_this_table == $ShortLines and $col_in_this_table == 5)
 915                         {
 916                                 print $fh "  </tr>\n",
 917                                 qq#</table>\n\n#;
 918                         }
 919                 }
 920
 921                 # There is no else. There are
 922                 # just too many people around.
 923                 # I might add a "There are xyz
 924                 # unmentioned nicks"-line..
 925         }
 926
 927         if (($linescount > $LongLines)
 928                         and ($linescount <= ($LongLines + 6 * $ShortLines)))
 929         {
 930                 my $col = ($linescount - $LongLines - 1) % 6;
 931
 932                 while ($col < 5)
 933                 {
 934                         print $fh qq#    <td>&nbsp;</td>\n#;
 935                         $col++;
 936                 }
 937
 938                 print $fh "  </tr>\n";
 939         }
 940
 941         if ($linescount != $LongLines)
 942         {
 943                 print $fh "</table>\n\n";
 944         }
 945 }
 946
 947 # this is called by "&ranking ();" and prints the horizontal usage-bar in the
 948 # detailed nick-table
 949 sub bar
 950 {
 951         my $max_num = shift;
 952         my $source = shift;
 953
 954         confess () unless (ref ($source) eq 'ARRAY');
 955
 956         # BAR_WIDTH is a least 10
 957         my $max_width = $BAR_WIDTH - 4;
 958         my $factor = 1;
 959         my $retval = '';
 960
 961         my $i;
 962         my $j;
 963
 964         if (!$max_num) { return ($retval); }
 965         $factor = $max_width / $max_num;
 966
 967         for ($i = 0; $i < 4; $i++)
 968         {
 969                 my $sum = 0;
 970                 my $width = 1;
 971                 my $img = $H_IMAGES[$i];
 972
 973                 for ($j = 0; $j < 6; $j++)
 974                 {
 975                         my $hour = ($i * 6) + $j;
 976                         $sum += $source->[$hour];
 977                 }
 978
 979                 $width += int (0.5 + ($sum * $factor));
 980
 981                 $retval .= qq#<img src="$img" style="width: # . $width . q#px"#;
 982                 if ($i == 0) { $retval .= qq# class="first"#; }
 983                 elsif ($i == 3) { $retval .= qq# class="last"#; }
 984                 $retval .= qq( alt="$sum" />);
 985         }
 986
 987         return ($retval);
 988 }
 989
 990 =head1 EXPORTED FUNCTIONS
 991
 992 =over 4
 993
 994 =item B<get_core_nick_counters> (I<$nick>)
 995
 996 Returns a hash-ref that containes all the nick-counters available. It looks
 997 like this:
 998
 999     {
1000         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)],
1001         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)],
1002         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)],
1003         lines_total => 0,
1004         words_total => 0,
1005         chars_total => 0
1006     }
1007
1008 =cut
1009
1010 sub get_core_nick_counters
1011 {
1012         my $nick = shift;
1013
1014         if (!defined ($NickData->{$nick}))
1015         {
1016                 return ({});
1017         }
1018
1019         return ($NickData->{$nick});
1020 }
1021
1022 =item B<get_sorted_nicklist> ()
1023
1024 Returns an array-ref that containes all nicks, sorted by the field given in the
1025 config-file.
1026
1027 =cut
1028
1029 sub get_sorted_nicklist
1030 {
1031         return ($SortedNicklist);
1032 }
1033
1034 =back
1035
1036 =head1 AUTHOR
1037
1038 Florian octo Forster, E<lt>octo at verplant.orgE<gt>
1039
1040 =cut