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