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 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;
27 @Onis::Plugins::Core::EXPORT_OK = (qw(get_core_nick_counters get_sorted_nicklist));
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 @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;
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;
73 =head1 CONFIGURATION OPTIONS
77 =item B<quote_cache_size>: I<10>
79 Sets how many quotes are cached and, at the end, one is chosen at random.
83 if (get_config ('quote_cache_size'))
85 my $tmp = get_config ('quote_cache_size');
87 $QuoteCacheSize = $tmp if ($tmp);
90 =item B<quote_min>: I<30>
92 Minimum number of characters in a line to be included in the quote-cache.
96 if (get_config ('quote_min'))
98 my $tmp = get_config ('quote_min');
100 $QuoteMin = $tmp if ($tmp);
102 =item B<quote_max>: I<80>
104 Maximum number of characters in a line to be included in the quote-cache.
108 if (get_config ('quote_max'))
110 my $tmp = get_config ('quote_max');
112 $QuoteMax = $tmp if ($tmp);
115 =item B<min_word_length>: I<5>
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..
122 if (get_config ('min_word_length'))
124 my $tmp = get_config ('min_word_length');
126 $WORD_LENGTH = $tmp if ($tmp);
129 =item B<display_lines>: I<BOTH>
131 Choses wether to display B<lines> as I<BAR>, I<NUMBER>, I<BOTH> or not at all
136 if (get_config ('display_lines'))
138 my $tmp = get_config ('display_lines');
141 if (($tmp eq 'NONE') or ($tmp eq 'BAR') or ($tmp eq 'NUMBER') or ($tmp eq 'BOTH'))
143 $DISPLAY_LINES = $tmp;
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''.";
153 =item B<display_words>: I<NONE>
159 if (get_config ('display_words'))
161 my $tmp = get_config ('display_words');
164 if (($tmp eq 'NONE') or ($tmp eq 'BAR') or ($tmp eq 'NUMBER') or ($tmp eq 'BOTH'))
166 $DISPLAY_WORDS = $tmp;
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''.";
176 =item B<display_chars>: I<NONE>
182 if (get_config ('display_chars'))
184 my $tmp = get_config ('display_chars');
187 if (($tmp eq 'NONE') or ($tmp eq 'BAR') or ($tmp eq 'NUMBER') or ($tmp eq 'BOTH'))
189 $DISPLAY_CHARS = $tmp;
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''.";
199 =item B<display_times>: I<false>
201 Wether or not to display a fixed width bar that shows when a user is most
206 if (get_config ('display_times'))
208 my $tmp = get_config ('display_times');
210 if ($tmp =~ m/true|on|yes/i)
214 elsif ($tmp =~ m/false|off|no/i)
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''.";
225 =item B<display_images>: I<false>
227 Wether or not to display images in the main ranking.
231 if (get_config ('display_images'))
233 my $tmp = get_config ('display_images');
235 if ($tmp =~ m/true|on|yes/i)
239 elsif ($tmp =~ m/false|off|no/i)
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''.";
250 =item B<default_image>: I<http://www.url.org/image.png>
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.
257 if (get_config ('default_image'))
259 $DEFAULT_IMAGE = get_config ('default_image');
262 =item B<sort_by>: I<LINES>
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>.
270 if (get_config ('sort_by'))
272 my $tmp = get_config ('sort_by');
275 if (($tmp eq 'LINES') or ($tmp eq 'WORDS') or ($tmp eq 'CHARS'))
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''.";
287 =item B<horizontal_images>: I<image1>, I<image2>, I<image3>, I<image4>
289 Sets the B<four> images used for horizontal bars/graphs. As above: You have to
290 take care of correctness of paths yourself.
294 if (get_config ('horizontal_images'))
296 my @tmp = get_config ('horizontal_images');
299 if (scalar (@tmp) != 4)
301 print STDERR $/, __FILE__, ": The number of horizontal images is not four. The output might look weird.", $/;
304 for ($i = 0; $i < 4; $i++)
306 if (!defined ($tmp[$i]))
311 $H_IMAGES[$i] = $tmp[$i];
315 =item B<bar_height>: I<130>
317 Sets the height (in pixels) of the highest vertical graph.
321 if (get_config ('bar_height'))
323 my $tmp = get_config ('bar_height');
325 $BAR_HEIGHT = $tmp if ($tmp >= 10);
328 =item B<bar_width>: I<100>
330 Sets the width (in pixels) of the widest horizontal graph.
334 if (get_config ('bar_width'))
336 my $tmp = get_config ('bar_width');
338 $BAR_WIDTH = $tmp if ($tmp >= 10);
341 =item B<longlines>: I<50>
343 Sets the number of rows of the main ranking table.
347 if (get_config ('longlines'))
349 my $tmp = get_config ('longlines');
351 $LongLines = $tmp if ($tmp);
354 =item B<shortlines>: I<10>
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.
363 if (get_config ('shortlines'))
365 my $tmp = get_config ('shortlines');
367 if ($tmp or ($tmp == 0))
373 register_plugin ('TEXT', \&add);
374 register_plugin ('ACTION', \&add);
375 register_plugin ('OUTPUT', \&output);
377 my $VERSION = '$Id$';
378 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
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'};
394 my $words = scalar (@{$data->{'words'}});
395 my $chars = length ($text);
397 if ($type eq 'ACTION')
399 $chars -= (length ($nick) + 3);
402 my @counter = $NickLinesCounter->get ($nick);
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);
408 $NickLinesCounter->put ($nick, @counter);
410 @counter = $NickWordsCounter->get ($nick);
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);
415 $counter[$hour] += $words;
416 $NickWordsCounter->put ($nick, @counter);
418 @counter = $NickCharsCounter->get ($nick);
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);
423 $counter[$hour] += $chars;
424 $NickCharsCounter->put ($nick, @counter);
426 if ((length ($text) >= $QuoteMin)
427 and (length ($text) <= $QuoteMax))
429 my ($pointer) = $QuotePtr->get ($nick);
432 my $key = sprintf ("%s:%02i", $nick, $pointer);
434 $QuoteCache->put ($key, $time, $text);
436 $pointer = ($pointer + 1) % $QuoteCacheSize;
437 $QuotePtr->put ($nick, $pointer);
444 for (get_all_nicks ())
447 my $main = get_main_nick ($nick);
449 if (!defined ($NickData->{$main}))
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)],
462 my @counter = $NickLinesCounter->get ($nick);
466 for (my $i = 0; $i < 24; $i++)
468 $NickData->{$main}{'lines'}[$i] += $counter[$i];
469 $sum += $counter[$i];
471 $NickData->{$main}{'lines_total'} += $sum;
474 @counter = $NickWordsCounter->get ($nick);
478 for (my $i = 0; $i < 24; $i++)
480 $NickData->{$main}{'words'}[$i] += $counter[$i];
481 $sum += $counter[$i];
483 $NickData->{$main}{'words_total'} += $sum;
486 @counter = $NickCharsCounter->get ($nick);
490 for (my $i = 0; $i < 24; $i++)
492 $NickData->{$main}{'chars'}[$i] += $counter[$i];
493 $sum += $counter[$i];
495 $NickData->{$main}{'chars_total'} += $sum;
498 if (!defined ($QuoteData->{$main}))
500 $QuoteData->{$main} = [];
504 for ($QuoteCache->keys ())
507 my ($nick, $num) = split (m/:/, $key);
508 my $main = get_main_nick ($nick);
510 my ($epoch, $text) = $QuoteCache->get ($key);
511 die unless (defined ($text));
513 if (!defined ($QuoteData->{$main}))
517 elsif (scalar (@{$QuoteData->{$main}}) < $QuoteCacheSize)
519 push (@{$QuoteData->{$main}}, [$epoch, $text]);
526 for (my $i = 0; $i < $QuoteCacheSize; $i++)
528 if ($QuoteData->{$main}[$i][0] < $min)
531 $min = $QuoteData->{$main}[$i][0];
537 $QuoteData->{$main}[$insert] = [$epoch, $text];
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
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);
558 my @img_urls = get_config ('vertical_images');
561 @img_urls = qw#images/ver0n.png images/ver1n.png images/ver2n.png images/ver3n.png#;
564 my $fh = get_filehandle () or die;
566 # this for loop looks for the most amount of lines in one hour and sets
568 for (keys %$NickData)
572 for (my $i = 0; $i < 24; $i++)
574 $data[$i] += $NickData->{$nick}{'chars'}[$i];
578 for (my $i = 0; $i < 24; $i++)
580 $max = $data[$i] if ($max < $data[$i]);
590 $factor = (($BAR_HEIGHT - 1) / $max);
592 my $header = translate ('When do we actually talk here?');
593 print $fh "<h2>$header</h2>\n",
594 qq#<table class="hours_of_day">\n#,
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++)
601 for (my $j = 0; $j <= 5; $j++)
603 my $hour = (($i * 6) + $j);
604 if (!defined ($data[$hour]))
609 my $percent = 100 * ($data[$hour] / $total);
610 my $height = int ($data[$hour] * $factor) + 1;
611 my $img_url = $img_urls[$i];
613 print $fh ' <td>', sprintf ("%2.1f", $percent),
614 qq#%<br /><img src="$img_url" style="height: $height#,
615 qq#px;" alt="" /></td>\n#;
619 print $fh " </tr>\n",
620 qq# <tr class="hour_row">\n#;
621 print $fh map { " <td>$_</td>\n" } (0 .. 23);
622 print $fh " </tr>\n",
630 my @nicks = keys (%$NickData);
632 return unless (@nicks);
640 my $fh = get_filehandle () or die;
642 my $sort_field = lc ($SORT_BY);
647 ($tmp) = sort { $NickData->{$b}{'lines_total'} <=> $NickData->{$a}{'lines_total'} } (@nicks);
648 $max_lines = $NickData->{$tmp}{'lines_total'} || 0;
650 ($tmp) = sort { $NickData->{$b}{'words_total'} <=> $NickData->{$a}{'words_total'} } (@nicks);
651 $max_words = $NickData->{$tmp}{'words_total'} || 0;
653 ($tmp) = sort { $NickData->{$b}{'chars_total'} <=> $NickData->{$a}{'chars_total'} } (@nicks);
654 $max_chars = $NickData->{$tmp}{'chars_total'} || 0;
656 $trans = translate ('Most active nicks');
658 print $fh "<h2>$trans</h2>\n";
659 if ($SORT_BY eq 'LINES')
661 $trans = translate ('Nicks sorted by numbers of lines written');
663 elsif ($SORT_BY eq 'WORDS')
665 $trans = translate ('Nicks sorted by numbers of words written');
667 else # ($SORT_BY eq 'CHARS')
669 $trans = translate ('Nicks sorted by numbers of characters written');
671 print $fh "<p>($trans)</p>\n";
675 <table class="big_ranking">
677 <td class="invis"> </td>
681 $trans = translate ('Image');
682 print $fh " <th>$trans</th>\n";
686 $trans = translate ('Nick');
687 print $fh " <th>$trans</th>\n";
689 if ($DISPLAY_LINES ne 'NONE')
691 $trans = translate ('Number of Lines');
692 print $fh " <th>$trans</th>\n";
694 if ($DISPLAY_WORDS ne 'NONE')
696 $trans = translate ('Number of Words');
697 print $fh " <th>$trans</th>\n";
699 if ($DISPLAY_CHARS ne 'NONE')
701 $trans = translate ('Number of Characters');
702 print $fh " <th>$trans</th>\n";
706 $trans = translate ('When?');
707 print $fh " <th>$trans</th>\n";
710 $trans = translate ('Random Quote');
711 print $fh " <th>$trans</th>\n",
714 @$SortedNicklist = sort
716 $NickData->{$b}{"${sort_field}_total"} <=> $NickData->{$a}{"${sort_field}_total"}
721 for (@$SortedNicklist)
724 my $ident = nick_to_ident ($nick);
725 my $name = ident_to_name ($ident);
726 my $print = $name || $nick;
730 # As long as we didn't hit the
731 # $LongLines-limit we continue
733 if ($linescount <= $LongLines)
735 my $quote = translate ('-- no quote available --');
737 if (@{$QuoteData->{$nick}})
739 my $num = scalar (@{$QuoteData->{$nick}});
740 my $rand = int (rand ($num));
742 $quote = html_escape ($QuoteData->{$nick}[$rand][1]);
750 $link = get_link ($name);
751 $image = get_image ($name);
752 $realname = get_realname ($name);
756 qq# <td class="numeration"># . $linescount . "</td>\n";
760 if ($DEFAULT_IMAGE and !$image)
762 $image = $DEFAULT_IMAGE;
765 print $fh qq# <td class="image">#;
770 print $fh qq#<a href="$link">#;
772 print $fh qq#<img src="$image" alt="$name" />#;
785 my $title = $realname;
788 $title = "User: $name; " if ($name);
789 $title .= "Ident: $ident";
791 print $fh qq# <td class="nick" title="$title">#;
795 print $fh qq#<a href="$link">$print</a></td>\n#
799 print $fh qq#$print</td>\n#;
802 if ($DISPLAY_LINES ne 'NONE')
804 print $fh qq# <td class="bar">#;
805 if (($DISPLAY_LINES eq 'BOTH') or ($DISPLAY_LINES eq 'BAR'))
807 my $code = bar ($max_lines, $NickData->{$nick}{'lines'});
810 print $fh ' ' if ($DISPLAY_LINES eq 'BOTH');
811 if (($DISPLAY_LINES eq 'BOTH') or ($DISPLAY_LINES eq 'NUMBER'))
813 print $fh $NickData->{$nick}{'lines_total'};
818 if ($DISPLAY_WORDS ne 'NONE')
820 print $fh qq# <td class="bar">#;
821 if (($DISPLAY_WORDS eq 'BOTH') or ($DISPLAY_WORDS eq 'BAR'))
823 my $code = bar ($max_words, $NickData->{$nick}{'words'});
826 print $fh ' ' if ($DISPLAY_WORDS eq 'BOTH');
827 if (($DISPLAY_WORDS eq 'BOTH') or ($DISPLAY_WORDS eq 'NUMBER'))
829 print $fh $NickData->{$nick}{'words_total'};
834 if ($DISPLAY_CHARS ne 'NONE')
836 print $fh qq# <td class="bar">#;
837 if (($DISPLAY_CHARS eq 'BOTH') or ($DISPLAY_CHARS eq 'BAR'))
839 my $code = bar ($max_chars, $NickData->{$nick}{'chars'});
842 print $fh ' ' if ($DISPLAY_CHARS eq 'BOTH');
843 if (($DISPLAY_CHARS eq 'BOTH') or ($DISPLAY_CHARS eq 'NUMBER'))
845 print $fh $NickData->{$nick}{'chars_total'};
852 my $code = bar ($NickData->{$nick}{'chars_total'}, $NickData->{$nick}{'chars'});
853 print $fh qq# <td class="bar">$code</td>\n#;
856 print $fh qq# <td class="quote">$quote</td>\n#,
859 if ($linescount == $LongLines)
861 print $fh "</table>\n\n";
865 # Ok, we have too many people to
866 # list them all so we start a
867 # smaller table and just list the
868 # names.. (Six names per line..)
869 elsif ($linescount <= ($LongLines + 6 * $ShortLines))
871 my $row_in_this_table = int (($linescount - $LongLines - 1) / 6);
872 my $col_in_this_table = ($linescount - $LongLines - 1) % 6;
875 if ($SORT_BY eq 'LINES')
877 $total = $NickData->{$nick}{'lines_total'};
879 elsif ($SORT_BY eq 'WORDS')
881 $total = $NickData->{$nick}{'words_total'};
883 else # ($SORT_BY eq 'CHARS')
885 $total = $NickData->{$nick}{'chars_total'};
888 my $title = $name ? get_realname ($name) : '';
891 $title = "User: $name; " if ($name);
892 $title .= "Ident: $ident";
895 if ($row_in_this_table == 0 and $col_in_this_table == 0)
897 $trans = translate ("They didn't write so much");
898 print $fh "<h2>$trans</h2>\n",
899 qq#<table class="small_ranking">\n#,
903 if ($col_in_this_table == 0 and $row_in_this_table != 0)
905 print $fh " </tr>\n",
909 print $fh qq# <td title="$title">$print ($total)</td>\n#;
911 if ($row_in_this_table == $ShortLines and $col_in_this_table == 5)
913 print $fh " </tr>\n",
918 # There is no else. There are
919 # just too many people around.
920 # I might add a "There are xyz
921 # unmentioned nicks"-line..
924 if (($linescount > $LongLines)
925 and ($linescount <= ($LongLines + 6 * $ShortLines)))
927 my $col = ($linescount - $LongLines - 1) % 6;
931 print $fh qq# <td> </td>\n#;
935 print $fh " </tr>\n";
938 if ($linescount != $LongLines)
940 print $fh "</table>\n\n";
944 # this is called by "&ranking ();" and prints the horizontal usage-bar in the
945 # detailed nick-table
951 confess () unless (ref ($source) eq 'ARRAY');
953 # BAR_WIDTH is a least 10
954 my $max_width = $BAR_WIDTH - 4;
961 if (!$max_num) { return ($retval); }
962 $factor = $max_width / $max_num;
964 for ($i = 0; $i < 4; $i++)
968 my $img = $H_IMAGES[$i];
970 for ($j = 0; $j < 6; $j++)
972 my $hour = ($i * 6) + $j;
973 $sum += $source->[$hour];
976 $width += int (0.5 + ($sum * $factor));
978 $retval .= qq#<img src="$img" style="width: # . $width . q#px"#;
979 if ($i == 0) { $retval .= qq# class="first"#; }
980 elsif ($i == 3) { $retval .= qq# class="last"#; }
981 $retval .= qq( alt="$sum" />);
987 =head1 EXPORTED FUNCTIONS
991 =item B<get_core_nick_counters> (I<$nick>)
993 Returns a hash-ref that containes all the nick-counters available. It looks
997 lines => [qw(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)],
998 words => [qw(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)],
999 chars => [qw(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)],
1007 sub get_core_nick_counters
1011 if (!defined ($NickData->{$nick}))
1016 return ($NickData->{$nick});
1019 =item B<get_sorted_nicklist> ()
1021 Returns an array-ref that containes all nicks, sorted by the field given in the
1026 sub get_sorted_nicklist
1028 return ($SortedNicklist);
1035 Florian octo Forster, E<lt>octo at verplant.orgE<gt>