1 package Onis::Plugins::Core;
6 use Carp (qw(confess));
15 Plugin for the main table and the hourly-statistics. This is the most
16 complicated plugin so far.
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 ();
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');
30 our $NickLinesCounter = Onis::Data::Persistent->new ('NickLinesCounter', 'nick',
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
36 our $NickWordsCounter = Onis::Data::Persistent->new ('NickWordsCounter', 'nick',
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
42 our $NickCharsCounter = Onis::Data::Persistent->new ('NickCharsCounter', 'nick',
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
49 our $QuoteCache = Onis::Data::Persistent->new ('QuoteCache', 'key', qw(epoch text));
50 our $QuotePtr = Onis::Data::Persistent->new ('QuotePtr', 'nick', qw(pointer));
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 = [];
56 our $NicksInMainTable = {};
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;
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 = '';
72 =head1 CONFIGURATION OPTIONS
76 =item B<quote_cache_size>: I<10>
78 Sets how many quotes are cached and, at the end, one is chosen at random.
82 if (get_config ('quote_cache_size'))
84 my $tmp = get_config ('quote_cache_size');
86 $QuoteCacheSize = $tmp if ($tmp);
89 =item B<quote_min>: I<30>
91 Minimum number of characters in a line to be included in the quote-cache.
95 if (get_config ('quote_min'))
97 my $tmp = get_config ('quote_min');
99 $QuoteMin = $tmp if ($tmp);
101 =item B<quote_max>: I<80>
103 Maximum number of characters in a line to be included in the quote-cache.
107 if (get_config ('quote_max'))
109 my $tmp = get_config ('quote_max');
111 $QuoteMax = $tmp if ($tmp);
114 =item B<display_lines>: I<BOTH>
116 Choses wether to display B<lines> as I<BAR>, I<NUMBER>, I<BOTH> or not at all
121 if (get_config ('display_lines'))
123 my $tmp = get_config ('display_lines');
126 if (($tmp eq 'NONE') or ($tmp eq 'BAR') or ($tmp eq 'NUMBER') or ($tmp eq 'BOTH'))
128 $DisplayLines = $tmp;
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''.";
138 =item B<display_words>: I<NONE>
144 if (get_config ('display_words'))
146 my $tmp = get_config ('display_words');
149 if (($tmp eq 'NONE') or ($tmp eq 'BAR') or ($tmp eq 'NUMBER') or ($tmp eq 'BOTH'))
151 $DisplayWords = $tmp;
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''.";
161 =item B<display_chars>: I<NONE>
167 if (get_config ('display_chars'))
169 my $tmp = get_config ('display_chars');
172 if (($tmp eq 'NONE') or ($tmp eq 'BAR') or ($tmp eq 'NUMBER') or ($tmp eq 'BOTH'))
174 $DisplayChars = $tmp;
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''.";
184 =item B<display_times>: I<false>
186 Wether or not to display a fixed width bar that shows when a user is most
191 if (get_config ('display_times'))
193 my $tmp = get_config ('display_times');
195 if ($tmp =~ m/true|on|yes/i)
199 elsif ($tmp =~ m/false|off|no/i)
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''.";
210 =item B<display_images>: I<false>
212 Wether or not to display images in the main ranking.
216 if (get_config ('display_images'))
218 my $tmp = get_config ('display_images');
220 if ($tmp =~ m/true|on|yes/i)
224 elsif ($tmp =~ m/false|off|no/i)
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''.";
235 =item B<default_image>: I<http://www.url.org/image.png>
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.
242 if (get_config ('default_image'))
244 $DefaultImage = get_config ('default_image');
247 =item B<sort_by>: I<LINES>
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>.
255 if (get_config ('sort_by'))
257 my $tmp = get_config ('sort_by');
260 if (($tmp eq 'LINES') or ($tmp eq 'WORDS') or ($tmp eq 'CHARS'))
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''.";
272 =item B<horizontal_images>: I<image1>, I<image2>, I<image3>, I<image4>
274 Sets the B<four> images used for horizontal bars/graphs. As above: You have to
275 take care of correctness of paths yourself.
279 if (get_config ('horizontal_images'))
281 my @tmp = get_config ('horizontal_images');
284 if (scalar (@tmp) != 4)
286 print STDERR $/, __FILE__, ": The number of horizontal images is not four. The output might look weird.", $/;
289 for ($i = 0; $i < 4; $i++)
291 if (!defined ($tmp[$i]))
296 $HorizontalImages[$i] = $tmp[$i];
300 =item B<longlines>: I<50>
302 Sets the number of rows of the main ranking table.
306 if (get_config ('longlines'))
308 my $tmp = get_config ('longlines');
310 $LongLines = $tmp if ($tmp);
313 =item B<shortlines>: I<10>
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.
322 if (get_config ('shortlines'))
324 my $tmp = get_config ('shortlines');
326 if ($tmp or ($tmp == 0))
332 register_plugin ('TEXT', \&add);
333 register_plugin ('ACTION', \&add);
334 register_plugin ('OUTPUT', \&output);
336 my $VERSION = '$Id$';
337 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
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'};
353 my $words = scalar (@{$data->{'words'}});
354 my $chars = length ($text);
356 if ($type eq 'ACTION')
358 $chars -= (length ($nick) + 3);
361 my @counter = $NickLinesCounter->get ($nick);
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);
367 $NickLinesCounter->put ($nick, @counter);
369 @counter = $NickWordsCounter->get ($nick);
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);
374 $counter[$hour] += $words;
375 $NickWordsCounter->put ($nick, @counter);
377 @counter = $NickCharsCounter->get ($nick);
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);
382 $counter[$hour] += $chars;
383 $NickCharsCounter->put ($nick, @counter);
385 if ((length ($text) >= $QuoteMin)
386 and (length ($text) <= $QuoteMax))
388 my ($pointer) = $QuotePtr->get ($nick);
391 my $key = sprintf ("%s:%02i", $nick, $pointer);
393 $QuoteCache->put ($key, $time, $text);
395 $pointer = ($pointer + 1) % $QuoteCacheSize;
396 $QuotePtr->put ($nick, $pointer);
403 for (get_all_nicks ())
406 my $main = get_main_nick ($nick);
408 if (!defined ($NickData->{$main}))
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)],
421 my @counter = $NickLinesCounter->get ($nick);
425 for (my $i = 0; $i < 24; $i++)
427 $NickData->{$main}{'lines'}[$i] += $counter[$i];
428 $sum += $counter[$i];
430 $NickData->{$main}{'lines_total'} += $sum;
433 @counter = $NickWordsCounter->get ($nick);
437 for (my $i = 0; $i < 24; $i++)
439 $NickData->{$main}{'words'}[$i] += $counter[$i];
440 $sum += $counter[$i];
442 $NickData->{$main}{'words_total'} += $sum;
445 @counter = $NickCharsCounter->get ($nick);
449 for (my $i = 0; $i < 24; $i++)
451 $NickData->{$main}{'chars'}[$i] += $counter[$i];
452 $sum += $counter[$i];
454 $NickData->{$main}{'chars_total'} += $sum;
457 if (!defined ($QuoteData->{$main}))
459 $QuoteData->{$main} = [];
463 for ($QuoteCache->keys ())
466 my ($nick, $num) = split (m/:/, $key);
467 my $main = get_main_nick ($nick);
469 my ($epoch, $text) = $QuoteCache->get ($key);
470 die unless (defined ($text));
472 if (!defined ($QuoteData->{$main}))
476 elsif (scalar (@{$QuoteData->{$main}}) < $QuoteCacheSize)
478 push (@{$QuoteData->{$main}}, [$epoch, $text]);
485 for (my $i = 0; $i < $QuoteCacheSize; $i++)
487 if ($QuoteData->{$main}[$i][0] < $min)
490 $min = $QuoteData->{$main}[$i][0];
496 $QuoteData->{$main}[$insert] = [$epoch, $text];
511 my $max = 0; # the most lines that were written in one hour..
512 my $total = 0; # the total amount of lines we wrote..
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);
516 my @img_urls = get_config ('vertical_images');
519 @img_urls = qw#images/ver0n.png images/ver1n.png images/ver2n.png images/ver3n.png#;
522 my $fh = get_filehandle () or die;
524 # this for loop looks for the most amount of lines in one hour and sets
526 for (keys %$NickData)
530 for (my $i = 0; $i < 24; $i++)
532 $data[$i] += $NickData->{$nick}{'chars'}[$i];
536 for (my $i = 0; $i < 24; $i++)
538 $max = $data[$i] if ($max < $data[$i]);
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#;
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++)
557 for (my $j = 0; $j < 6; $j++)
559 my $hour = (($i * 6) + $j);
560 if (!defined ($data[$hour]))
565 my $height = sprintf ("%.2f", 95 * $data[$hour] / $max);
566 my $img = $img_urls[$i];
568 print $fh qq# <td class="bar vertical"><img src="$img" class="first last" style="height: $height\%;" alt="" /></td>\n#;
571 print $fh qq# </tr>\n <tr class="counter">\n#;
572 for (my $i = 0; $i < 24; $i++)
574 my $percent = sprintf ("%.1f", 100 * $data[$i] / $total);
575 print $fh qq# <td class="counter">$percent\%</td>\n#;
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",
589 my @nicks = keys (%$NickData);
591 return unless (@nicks);
599 my $fh = get_filehandle () or die;
601 my $sort_field = lc ($SortBy);
606 ($tmp) = sort { $NickData->{$b}{'lines_total'} <=> $NickData->{$a}{'lines_total'} } (@nicks);
607 $max_lines = $NickData->{$tmp}{'lines_total'} || 0;
609 ($tmp) = sort { $NickData->{$b}{'words_total'} <=> $NickData->{$a}{'words_total'} } (@nicks);
610 $max_words = $NickData->{$tmp}{'words_total'} || 0;
612 ($tmp) = sort { $NickData->{$b}{'chars_total'} <=> $NickData->{$a}{'chars_total'} } (@nicks);
613 $max_chars = $NickData->{$tmp}{'chars_total'} || 0;
615 $trans = translate ('Most active nicks');
617 print $fh "<h2>$trans</h2>\n";
618 if ($SortBy eq 'LINES')
620 $trans = translate ('Nicks sorted by numbers of lines written');
622 elsif ($SortBy eq 'WORDS')
624 $trans = translate ('Nicks sorted by numbers of words written');
626 else # ($SortBy eq 'CHARS')
628 $trans = translate ('Nicks sorted by numbers of characters written');
630 print $fh "<p>($trans)</p>\n";
634 <table class="big_ranking">
636 <td class="invis"> </td>
640 $trans = translate ('Image');
641 print $fh " <th>$trans</th>\n";
645 $trans = translate ('Nick');
646 print $fh " <th>$trans</th>\n";
648 if ($DisplayLines ne 'NONE')
650 my $span = $DisplayLines eq 'BOTH' ? ' colspan="2"' : '';
651 $trans = translate ('Number of Lines');
652 print $fh " <th$span>$trans</th>\n";
654 if ($DisplayWords ne 'NONE')
656 my $span = $DisplayWords eq 'BOTH' ? ' colspan="2"' : '';
657 $trans = translate ('Number of Words');
658 print $fh " <th$span>$trans</th>\n";
660 if ($DisplayChars ne 'NONE')
662 my $span = $DisplayChars eq 'BOTH' ? ' colspan="2"' : '';
663 $trans = translate ('Number of Characters');
664 print $fh " <th$span>$trans</th>\n";
668 $trans = translate ('When?');
669 print $fh " <th>$trans</th>\n";
672 $trans = translate ('Random Quote');
673 print $fh " <th>$trans</th>\n",
676 @$SortedNicklist = sort
678 $NickData->{$b}{"${sort_field}_total"} <=> $NickData->{$a}{"${sort_field}_total"}
683 for (@$SortedNicklist)
686 my $ident = nick_to_ident ($nick);
687 my $name = chatter_to_name ("$nick!$ident");
688 my $print = $name || $nick;
692 # As long as we didn't hit the
693 # $LongLines-limit we continue
695 if ($linescount <= $LongLines)
697 $NicksInMainTable->{$nick} = $linescount;
699 my $quote = translate ('-- no quote available --');
701 if (@{$QuoteData->{$nick}})
703 my $num = scalar (@{$QuoteData->{$nick}});
704 my $rand = int (rand ($num));
706 $quote = html_escape ($QuoteData->{$nick}[$rand][1]);
714 $link = get_link ($name);
715 $image = get_image ($name);
716 $realname = get_realname ($name);
720 qq# <td class="numeration"># . $linescount . "</td>\n";
724 if ($DefaultImage and !$image)
726 $image = $DefaultImage;
729 print $fh qq# <td class="image">#;
734 print $fh qq#<a href="$link">#;
736 print $fh qq#<img src="$image" alt="$name" />#;
749 my $title = $realname;
752 $title = "User: $name; " if ($name);
753 $title .= "Ident: $ident";
755 print $fh qq# <td class="nick" title="$title">#;
759 print $fh qq#<a href="$link">$print</a></td>\n#
763 print $fh qq#$print</td>\n#;
766 if ($DisplayLines ne 'NONE')
768 if (($DisplayLines eq 'BOTH') or ($DisplayLines eq 'NUMBER'))
770 my $num = $NickData->{$nick}{'lines_total'};
771 print $fh qq( <td class="counter">$num</td>\n);
773 if (($DisplayLines eq 'BOTH') or ($DisplayLines eq 'BAR'))
775 my $code = bar ($max_lines, $NickData->{$nick}{'lines'});
776 print $fh qq( <td class="bar horizontal">$code</td>\n);
780 if ($DisplayWords ne 'NONE')
782 if (($DisplayWords eq 'BOTH') or ($DisplayWords eq 'NUMBER'))
784 my $num = $NickData->{$nick}{'words_total'};
785 print $fh qq( <td class="counter">$num</td>\n);
787 if (($DisplayWords eq 'BOTH') or ($DisplayWords eq 'BAR'))
789 my $code = bar ($max_words, $NickData->{$nick}{'words'});
790 print $fh qq( <td class="bar horizontal">$code</td>\n);
794 if ($DisplayChars ne 'NONE')
796 if (($DisplayChars eq 'BOTH') or ($DisplayChars eq 'NUMBER'))
798 my $num = $NickData->{$nick}{'chars_total'};
799 print $fh qq( <td class="counter">$num</td>\n);
801 if (($DisplayChars eq 'BOTH') or ($DisplayChars eq 'BAR'))
803 my $code = bar ($max_chars, $NickData->{$nick}{'chars'});
804 print $fh qq( <td class="bar horizontal">$code</td>\n);
810 my $code = bar ($NickData->{$nick}{'chars_total'}, $NickData->{$nick}{'chars'});
811 print $fh qq# <td class="bar horizontal">$code</td>\n#;
814 print $fh qq# <td class="quote">$quote</td>\n#,
817 if ($linescount == $LongLines)
819 print $fh "</table>\n\n";
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))
829 my $row_in_this_table = int (($linescount - $LongLines - 1) / 6);
830 my $col_in_this_table = ($linescount - $LongLines - 1) % 6;
833 if ($SortBy eq 'LINES')
835 $total = $NickData->{$nick}{'lines_total'};
837 elsif ($SortBy eq 'WORDS')
839 $total = $NickData->{$nick}{'words_total'};
841 else # ($SortBy eq 'CHARS')
843 $total = $NickData->{$nick}{'chars_total'};
846 my $title = $name ? get_realname ($name) : '';
849 $title = "User: $name; " if ($name);
850 $title .= "Ident: $ident";
853 if ($row_in_this_table == 0 and $col_in_this_table == 0)
855 $trans = translate ("They didn't write so much");
856 print $fh "<h2>$trans</h2>\n",
857 qq#<table class="small_ranking">\n#,
861 if ($col_in_this_table == 0 and $row_in_this_table != 0)
863 print $fh " </tr>\n",
867 print $fh qq# <td title="$title">$print ($total)</td>\n#;
869 if ($row_in_this_table == $ShortLines and $col_in_this_table == 5)
871 print $fh " </tr>\n",
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..
882 if (($linescount > $LongLines)
883 and ($linescount <= ($LongLines + 6 * $ShortLines)))
885 my $col = ($linescount - $LongLines - 1) % 6;
889 print $fh qq# <td> </td>\n#;
893 print $fh " </tr>\n";
896 if ($linescount != $LongLines)
898 print $fh "</table>\n\n";
902 # this is called by "&ranking ();" and prints the horizontal usage-bar in the
903 # detailed nick-table
909 confess () unless (ref ($source) eq 'ARRAY');
916 for ($i = 0; $i < 4; $i++)
919 my $img = $HorizontalImages[$i];
922 for ($j = 0; $j < 6; $j++)
924 my $hour = ($i * 6) + $j;
925 $sum += $source->[$hour];
928 $width = sprintf ("%.2f", 95 * $sum / $max_num);
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" />);
939 =head1 EXPORTED FUNCTIONS
943 =item B<get_core_nick_counters> (I<$nick>)
945 Returns a hash-ref that containes all the nick-counters available. It looks
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)],
959 sub get_core_nick_counters
963 if (!defined ($NickData->{$nick}))
968 return ($NickData->{$nick});
971 =item B<get_sorted_nicklist> ()
973 Returns an array-ref that containes all nicks, sorted by the field given in the
978 sub get_sorted_nicklist
980 return ($SortedNicklist);
983 =item B<nick_is_in_main_table> (I<$nick>)
985 Returns the position of the nick in the main table or zero if it is not in the
990 sub nick_is_in_main_table
994 return (defined ($NicksInMainTable->{$nick}) ? $NicksInMainTable->{$nick} : 0);
1001 Florian octo Forster E<lt>octo at verplant.orgE<gt>