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 if (get_config ('quote_cache_size'))
75 my $tmp = get_config ('quote_cache_size');
77 $QuoteCacheSize = $tmp if ($tmp);
79 if (get_config ('quote_min'))
81 my $tmp = get_config ('quote_min');
83 $QuoteMin = $tmp if ($tmp);
85 if (get_config ('quote_max'))
87 my $tmp = get_config ('quote_max');
89 $QuoteMax = $tmp if ($tmp);
91 if (get_config ('min_word_length'))
93 my $tmp = get_config ('min_word_length');
95 $WORD_LENGTH = $tmp if ($tmp);
97 if (get_config ('display_lines'))
99 my $tmp = get_config ('display_lines');
102 if (($tmp eq 'NONE') or ($tmp eq 'BAR') or ($tmp eq 'NUMBER') or ($tmp eq 'BOTH'))
104 $DISPLAY_LINES = $tmp;
108 $tmp = get_config ('display_lines');
109 print STDERR $/, __FILE__, ": ``display_lines'' has been set to the invalid value ``$tmp''. ",
110 $/, __FILE__, ": Valid values are ``none'', ``bar'', ``number'' and ``both''. Using default value ``both''.";
113 if (get_config ('display_words'))
115 my $tmp = get_config ('display_words');
118 if (($tmp eq 'NONE') or ($tmp eq 'BAR') or ($tmp eq 'NUMBER') or ($tmp eq 'BOTH'))
120 $DISPLAY_WORDS = $tmp;
124 $tmp = get_config ('display_words');
125 print STDERR $/, __FILE__, ": ``display_words'' has been set to the invalid value ``$tmp''. ",
126 $/, __FILE__, ": Valid values are ``none'', ``bar'', ``number'' and ``both''. Using default value ``none''.";
129 if (get_config ('display_chars'))
131 my $tmp = get_config ('display_chars');
134 if (($tmp eq 'NONE') or ($tmp eq 'BAR') or ($tmp eq 'NUMBER') or ($tmp eq 'BOTH'))
136 $DISPLAY_CHARS = $tmp;
140 $tmp = get_config ('display_chars');
141 print STDERR $/, __FILE__, ": ``display_chars'' has been set to the invalid value ``$tmp''. ",
142 $/, __FILE__, ": Valid values are ``none'', ``bar'', ``number'' and ``both''. Using default value ``none''.";
145 if (get_config ('display_times'))
147 my $tmp = get_config ('display_times');
149 if ($tmp =~ m/true|on|yes/i)
153 elsif ($tmp =~ m/false|off|no/i)
159 print STDERR $/, __FILE__, ": ``display_times'' has been set to the invalid value ``$tmp''. ",
160 $/, __FILE__, ": Valid values are ``true'' and ``false''. Using default value ``false''.";
163 if (get_config ('display_images'))
165 my $tmp = get_config ('display_images');
167 if ($tmp =~ m/true|on|yes/i)
171 elsif ($tmp =~ m/false|off|no/i)
177 print STDERR $/, __FILE__, ": ``display_times'' has been set to the invalid value ``$tmp''. ",
178 $/, __FILE__, ": Valid values are ``true'' and ``false''. Using default value ``false''.";
181 if (get_config ('default_image'))
183 $DEFAULT_IMAGE = get_config ('default_image');
185 if (get_config ('sort_by'))
187 my $tmp = get_config ('sort_by');
190 if (($tmp eq 'LINES') or ($tmp eq 'WORDS') or ($tmp eq 'CHARS'))
196 $tmp = get_config ('sort_by');
197 print STDERR $/, __FILE__, ": ``sort_by'' has been set to the invalid value ``$tmp''. ",
198 $/, __FILE__, ": Valid values are ``lines'' and ``words''. Using default value ``lines''.";
201 if (get_config ('horizontal_images'))
203 my @tmp = get_config ('horizontal_images');
206 if (scalar (@tmp) != 4)
208 print STDERR $/, __FILE__, ": The number of horizontal images is not four. The output might look weird.", $/;
211 for ($i = 0; $i < 4; $i++)
213 if (!defined ($tmp[$i]))
218 $H_IMAGES[$i] = $tmp[$i];
221 if (get_config ('bar_height'))
223 my $tmp = get_config ('bar_height');
225 $BAR_HEIGHT = $tmp if ($tmp >= 10);
227 if (get_config ('bar_width'))
229 my $tmp = get_config ('bar_width');
231 $BAR_WIDTH = $tmp if ($tmp >= 10);
233 if (get_config ('longlines'))
235 my $tmp = get_config ('longlines');
237 $LongLines = $tmp if ($tmp);
239 if (get_config ('shortlines'))
241 my $tmp = get_config ('shortlines');
243 if ($tmp or ($tmp == 0))
249 register_plugin ('TEXT', \&add);
250 register_plugin ('ACTION', \&add);
251 register_plugin ('OUTPUT', \&output);
253 my $VERSION = '$Id$';
254 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
262 my $nick = $data->{'nick'};
263 my $ident = $data->{'ident'};
264 my $hour = int ($data->{'hour'});
265 my $host = $data->{'host'};
266 my $text = $data->{'text'};
267 my $type = $data->{'type'};
268 my $time = $data->{'epoch'};
270 my $words = scalar (@{$data->{'words'}});
271 my $chars = length ($text);
273 if ($type eq 'ACTION')
275 $chars -= (length ($nick) + 3);
278 my @counter = $NickLinesCounter->get ($nick);
281 @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);
284 $NickLinesCounter->put ($nick, @counter);
286 @counter = $NickWordsCounter->get ($nick);
289 @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);
291 $counter[$hour] += $words;
292 $NickWordsCounter->put ($nick, @counter);
294 @counter = $NickCharsCounter->get ($nick);
297 @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);
299 $counter[$hour] += $chars;
300 $NickCharsCounter->put ($nick, @counter);
302 if ((length ($text) >= $QuoteMin)
303 and (length ($text) <= $QuoteMax))
305 my ($pointer) = $QuotePtr->get ($nick);
308 my $key = sprintf ("%s:%02i", $nick, $pointer);
310 $QuoteCache->put ($key, $time, $text);
312 $pointer = ($pointer + 1) % $QuoteCacheSize;
313 $QuotePtr->put ($nick, $pointer);
320 for (get_all_nicks ())
323 my $main = get_main_nick ($nick);
325 if (!defined ($NickData->{$main}))
329 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)],
330 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)],
331 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)],
338 my @counter = $NickLinesCounter->get ($nick);
342 for (my $i = 0; $i < 24; $i++)
344 $NickData->{$main}{'lines'}[$i] += $counter[$i];
345 $sum += $counter[$i];
347 $NickData->{$main}{'lines_total'} = $sum;
350 @counter = $NickWordsCounter->get ($nick);
354 for (my $i = 0; $i < 24; $i++)
356 $NickData->{$main}{'words'}[$i] += $counter[$i];
357 $sum += $counter[$i];
359 $NickData->{$main}{'words_total'} = $sum;
362 @counter = $NickCharsCounter->get ($nick);
366 for (my $i = 0; $i < 24; $i++)
368 $NickData->{$main}{'chars'}[$i] += $counter[$i];
369 $sum += $counter[$i];
371 $NickData->{$main}{'chars_total'} = $sum;
374 if (!defined ($QuoteData->{$main}))
376 $QuoteData->{$main} = [];
380 for ($QuoteCache->keys ())
383 my ($nick, $num) = split (m/:/, $key);
384 my $main = get_main_nick ($nick);
386 my ($epoch, $text) = $QuoteCache->get ($key);
387 die unless (defined ($text));
389 if (!defined ($QuoteData->{$main}))
393 elsif (scalar (@{$QuoteData->{$main}}) < $QuoteCacheSize)
395 push (@{$QuoteData->{$main}}, [$epoch, $text]);
402 for (my $i = 0; $i < $QuoteCacheSize; $i++)
404 if ($QuoteData->{$main}[$i][0] < $min)
407 $min = $QuoteData->{$main}[$i][0];
413 $QuoteData->{$main}[$insert] = [$epoch, $text];
428 my $max = 0; # the most lines that were written in one hour..
429 my $total = 0; # the total amount of lines we wrote..
430 my $factor = 0; # used to find a bar's height
432 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);
434 my @img_urls = get_config ('vertical_images');
437 @img_urls = qw#images/ver0n.png images/ver1n.png images/ver2n.png images/ver3n.png#;
440 my $fh = get_filehandle () or die;
442 # this for loop looks for the most amount of lines in one hour and sets
444 for (keys %$NickData)
448 for (my $i = 0; $i < 24; $i++)
450 $data[$i] += $NickData->{$nick}{'chars'}[$i];
454 for (my $i = 0; $i < 24; $i++)
456 $max = $data[$i] if ($max < $data[$i]);
466 $factor = (($BAR_HEIGHT - 1) / $max);
468 my $header = translate ('When do we actually talk here?');
469 print $fh "<h2>$header</h2>\n",
470 qq#<table class="hours_of_day">\n#,
473 # this for circles through the four colors. Each color represents six hours.
474 # (4 * 6 hours = 24 hours)
475 for (my $i = 0; $i <= 3; $i++)
477 for (my $j = 0; $j <= 5; $j++)
479 my $hour = (($i * 6) + $j);
480 if (!defined ($data[$hour]))
485 my $percent = 100 * ($data[$hour] / $total);
486 my $height = int ($data[$hour] * $factor) + 1;
487 my $img_url = $img_urls[$i];
489 print $fh ' <td>', sprintf ("%2.1f", $percent),
490 qq#%<br /><img src="$img_url" style="height: $height#,
491 qq#px;" alt="" /></td>\n#;
495 print $fh " </tr>\n",
496 qq# <tr class="hour_row">\n#;
497 print $fh map { " <td>$_</td>\n" } (0 .. 23);
498 print $fh " </tr>\n",
506 my @nicks = keys (%$NickData);
508 return unless (@nicks);
516 my $fh = get_filehandle () or die;
518 my $sort_field = lc ($SORT_BY);
523 ($tmp) = sort { $NickData->{$b}{'lines_total'} <=> $NickData->{$a}{'lines_total'} } (@nicks);
524 $max_lines = $NickData->{$tmp}{'lines_total'} || 0;
526 ($tmp) = sort { $NickData->{$b}{'words_total'} <=> $NickData->{$a}{'words_total'} } (@nicks);
527 $max_words = $NickData->{$tmp}{'words_total'} || 0;
529 ($tmp) = sort { $NickData->{$b}{'chars_total'} <=> $NickData->{$a}{'chars_total'} } (@nicks);
530 $max_chars = $NickData->{$tmp}{'chars_total'} || 0;
532 $trans = translate ('Most active nicks');
534 print $fh "<h2>$trans</h2>\n";
535 if ($SORT_BY eq 'LINES')
537 $trans = translate ('Nicks sorted by numbers of lines written');
539 elsif ($SORT_BY eq 'WORDS')
541 $trans = translate ('Nicks sorted by numbers of words written');
543 else # ($SORT_BY eq 'CHARS')
545 $trans = translate ('Nicks sorted by numbers of characters written');
547 print $fh "<p>($trans)</p>\n";
551 <table class="big_ranking">
553 <td class="invis"> </td>
557 $trans = translate ('Image');
558 print $fh " <th>$trans</th>\n";
562 $trans = translate ('Nick');
563 print $fh " <th>$trans</th>\n";
565 if ($DISPLAY_LINES ne 'NONE')
567 $trans = translate ('Number of Lines');
568 print $fh " <th>$trans</th>\n";
570 if ($DISPLAY_WORDS ne 'NONE')
572 $trans = translate ('Number of Words');
573 print $fh " <th>$trans</th>\n";
575 if ($DISPLAY_CHARS ne 'NONE')
577 $trans = translate ('Number of Characters');
578 print $fh " <th>$trans</th>\n";
582 $trans = translate ('When?');
583 print $fh " <th>$trans</th>\n";
586 $trans = translate ('Random Quote');
587 print $fh " <th>$trans</th>\n",
590 @$SortedNicklist = sort
592 $NickData->{$b}{"${sort_field}_total"} <=> $NickData->{$a}{"${sort_field}_total"}
597 for (@$SortedNicklist)
600 my $ident = nick_to_ident ($nick);
601 my $name = ident_to_name ($ident);
602 my $print = $name || $nick;
606 # As long as we didn't hit the
607 # $LongLines-limit we continue
609 if ($linescount <= $LongLines)
611 my $quote = translate ('-- no quote available --');
613 if (@{$QuoteData->{$nick}})
615 my $num = scalar (@{$QuoteData->{$nick}});
616 my $rand = int (rand ($num));
618 $quote = html_escape ($QuoteData->{$nick}[$rand][1]);
626 $link = get_link ($name);
627 $image = get_image ($name);
628 $realname = get_realname ($name);
632 qq# <td class="numeration"># . $linescount . "</td>\n";
636 if ($DEFAULT_IMAGE and !$image)
638 $image = $DEFAULT_IMAGE;
641 print $fh qq# <td class="image">#;
646 print $fh qq#<a href="$link">#;
648 print $fh qq#<img src="$image" alt="$name" />#;
661 my $title = $realname;
664 $title = "User: $name; " if ($name);
665 $title .= "Ident: $ident";
667 print $fh qq# <td class="nick" title="$title">#;
671 print $fh qq#<a href="$link">$print</a></td>\n#
675 print $fh qq#$print</td>\n#;
678 if ($DISPLAY_LINES ne 'NONE')
680 print $fh qq# <td class="bar">#;
681 if (($DISPLAY_LINES eq 'BOTH') or ($DISPLAY_LINES eq 'BAR'))
683 my $code = bar ($max_lines, $NickData->{$nick}{'lines'});
686 print $fh ' ' if ($DISPLAY_LINES eq 'BOTH');
687 if (($DISPLAY_LINES eq 'BOTH') or ($DISPLAY_LINES eq 'NUMBER'))
689 print $fh $NickData->{$nick}{'lines_total'};
694 if ($DISPLAY_WORDS ne 'NONE')
696 print $fh qq# <td class="bar">#;
697 if (($DISPLAY_WORDS eq 'BOTH') or ($DISPLAY_WORDS eq 'BAR'))
699 my $code = bar ($max_words, $NickData->{$nick}{'words'});
702 print $fh ' ' if ($DISPLAY_WORDS eq 'BOTH');
703 if (($DISPLAY_WORDS eq 'BOTH') or ($DISPLAY_WORDS eq 'NUMBER'))
705 print $fh $NickData->{$nick}{'words_total'};
710 if ($DISPLAY_CHARS ne 'NONE')
712 print $fh qq# <td class="bar">#;
713 if (($DISPLAY_CHARS eq 'BOTH') or ($DISPLAY_CHARS eq 'BAR'))
715 my $code = bar ($max_chars, $NickData->{$nick}{'chars'});
718 print $fh ' ' if ($DISPLAY_CHARS eq 'BOTH');
719 if (($DISPLAY_CHARS eq 'BOTH') or ($DISPLAY_CHARS eq 'NUMBER'))
721 print $fh $NickData->{$nick}{'chars_total'};
728 my $code = bar ($NickData->{$nick}{'chars_total'}, $NickData->{$nick}{'chars'});
729 print $fh qq# <td class="bar">$code</td>\n#;
732 print $fh qq# <td class="quote">$quote</td>\n#,
735 if ($linescount == $LongLines)
737 print $fh "</table>\n\n";
741 # Ok, we have too many people to
742 # list them all so we start a
743 # smaller table and just list the
744 # names.. (Six names per line..)
745 elsif ($linescount <= ($LongLines + 6 * $ShortLines))
747 my $row_in_this_table = int (($linescount - $LongLines - 1) / 6);
748 my $col_in_this_table = ($linescount - $LongLines - 1) % 6;
751 if ($SORT_BY eq 'LINES')
753 $total = $NickData->{$nick}{'lines_total'};
755 elsif ($SORT_BY eq 'WORDS')
757 $total = $NickData->{$nick}{'words_total'};
759 else # ($SORT_BY eq 'CHARS')
761 $total = $NickData->{$nick}{'chars_total'};
764 my $title = $name ? get_realname ($name) : '';
767 $title = "User: $name; " if ($name);
768 $title .= "Ident: $ident";
771 if ($row_in_this_table == 0 and $col_in_this_table == 0)
773 $trans = translate ("They didn't write so much");
774 print $fh "<h2>$trans</h2>\n",
775 qq#<table class="small_ranking">\n#,
779 if ($col_in_this_table == 0 and $row_in_this_table != 0)
781 print $fh " </tr>\n",
785 print $fh qq# <td title="$title">$print ($total)</td>\n#;
787 if ($row_in_this_table == $ShortLines and $col_in_this_table == 5)
789 print $fh " </tr>\n",
794 # There is no else. There are
795 # just too many people around.
796 # I might add a "There are xyz
797 # unmentioned nicks"-line..
800 if (($linescount > $LongLines)
801 and ($linescount <= ($LongLines + 6 * $ShortLines)))
803 my $col = ($linescount - $LongLines - 1) % 6;
807 print $fh qq# <td> </td>\n#;
811 print $fh " </tr>\n";
814 if ($linescount != $LongLines)
816 print $fh "</table>\n\n";
820 # this is called by "&ranking ();" and prints the horizontal usage-bar in the
821 # detailed nick-table
827 confess () unless (ref ($source) eq 'ARRAY');
829 # BAR_WIDTH is a least 10
830 my $max_width = $BAR_WIDTH - 4;
837 if (!$max_num) { return ($retval); }
838 $factor = $max_width / $max_num;
840 for ($i = 0; $i < 4; $i++)
844 my $img = $H_IMAGES[$i];
846 for ($j = 0; $j < 6; $j++)
848 my $hour = ($i * 6) + $j;
849 $sum += $source->[$hour];
852 $width += int (0.5 + ($sum * $factor));
854 $retval .= qq#<img src="$img" style="width: # . $width . q#px"#;
855 if ($i == 0) { $retval .= qq# class="first"#; }
856 elsif ($i == 3) { $retval .= qq# class="last"#; }
857 $retval .= ' alt="" />';
863 =head1 EXPORTED FUNCTIONS
867 =item B<get_core_nick_counters> (I<$nick>)
869 Returns a hash-ref that containes all the nick-counters available. It looks
873 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)],
874 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)],
875 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)],
883 sub get_core_nick_counters
887 if (!defined ($NickData->{$nick}))
892 return ($NickData->{$nick});
895 =item B<get_sorted_nicklist> ()
897 Returns an array-ref that containes all nicks, sorted by the field given in the
902 sub get_sorted_nicklist
904 return ($SortedNicklist);
911 Florian octo Forster, E<lt>octo at verplant.orgE<gt>