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 = {}; # Saves per-nick information without any modification
50 our $QuoteData = {}; # Is generated before output. Nicks are merged according to Data::Core.
51 our $NickData = {}; # Same as above, but for nicks rather than quotes.
52 our $SortedNicklist = [];
54 our @H_IMAGES = qw#dark-theme/h-red.png dark-theme/h-blue.png dark-theme/h-yellow.png dark-theme/h-green.png#;
55 our $QuoteCacheSize = 10;
59 our $SORT_BY = 'LINES';
60 our $DISPLAY_LINES = 'BOTH';
61 our $DISPLAY_WORDS = 'NONE';
62 our $DISPLAY_CHARS = 'NONE';
63 our $DISPLAY_TIMES = 0;
64 our $DISPLAY_IMAGES = 0;
65 our $DEFAULT_IMAGE = '';
66 our $BAR_HEIGHT = 130;
71 if (get_config ('quote_cache_size'))
73 my $tmp = get_config ('quote_cache_size');
75 $QuoteCacheSize = $tmp if ($tmp);
77 if (get_config ('quote_min'))
79 my $tmp = get_config ('quote_min');
81 $QuoteMin = $tmp if ($tmp);
83 if (get_config ('quote_max'))
85 my $tmp = get_config ('quote_max');
87 $QuoteMax = $tmp if ($tmp);
89 if (get_config ('min_word_length'))
91 my $tmp = get_config ('min_word_length');
93 $WORD_LENGTH = $tmp if ($tmp);
95 if (get_config ('display_lines'))
97 my $tmp = get_config ('display_lines');
100 if (($tmp eq 'NONE') or ($tmp eq 'BAR') or ($tmp eq 'NUMBER') or ($tmp eq 'BOTH'))
102 $DISPLAY_LINES = $tmp;
106 $tmp = get_config ('display_lines');
107 print STDERR $/, __FILE__, ": ``display_lines'' has been set to the invalid value ``$tmp''. ",
108 $/, __FILE__, ": Valid values are ``none'', ``bar'', ``number'' and ``both''. Using default value ``both''.";
111 if (get_config ('display_words'))
113 my $tmp = get_config ('display_words');
116 if (($tmp eq 'NONE') or ($tmp eq 'BAR') or ($tmp eq 'NUMBER') or ($tmp eq 'BOTH'))
118 $DISPLAY_WORDS = $tmp;
122 $tmp = get_config ('display_words');
123 print STDERR $/, __FILE__, ": ``display_words'' has been set to the invalid value ``$tmp''. ",
124 $/, __FILE__, ": Valid values are ``none'', ``bar'', ``number'' and ``both''. Using default value ``none''.";
127 if (get_config ('display_chars'))
129 my $tmp = get_config ('display_chars');
132 if (($tmp eq 'NONE') or ($tmp eq 'BAR') or ($tmp eq 'NUMBER') or ($tmp eq 'BOTH'))
134 $DISPLAY_CHARS = $tmp;
138 $tmp = get_config ('display_chars');
139 print STDERR $/, __FILE__, ": ``display_chars'' has been set to the invalid value ``$tmp''. ",
140 $/, __FILE__, ": Valid values are ``none'', ``bar'', ``number'' and ``both''. Using default value ``none''.";
143 if (get_config ('display_times'))
145 my $tmp = get_config ('display_times');
147 if ($tmp =~ m/true|on|yes/i)
151 elsif ($tmp =~ m/false|off|no/i)
157 print STDERR $/, __FILE__, ": ``display_times'' has been set to the invalid value ``$tmp''. ",
158 $/, __FILE__, ": Valid values are ``true'' and ``false''. Using default value ``false''.";
161 if (get_config ('display_images'))
163 my $tmp = get_config ('display_images');
165 if ($tmp =~ m/true|on|yes/i)
169 elsif ($tmp =~ m/false|off|no/i)
175 print STDERR $/, __FILE__, ": ``display_times'' has been set to the invalid value ``$tmp''. ",
176 $/, __FILE__, ": Valid values are ``true'' and ``false''. Using default value ``false''.";
179 if (get_config ('default_image'))
181 $DEFAULT_IMAGE = get_config ('default_image');
183 if (get_config ('sort_by'))
185 my $tmp = get_config ('sort_by');
188 if (($tmp eq 'LINES') or ($tmp eq 'WORDS') or ($tmp eq 'CHARS'))
194 $tmp = get_config ('sort_by');
195 print STDERR $/, __FILE__, ": ``sort_by'' has been set to the invalid value ``$tmp''. ",
196 $/, __FILE__, ": Valid values are ``lines'' and ``words''. Using default value ``lines''.";
199 if (get_config ('horizontal_images'))
201 my @tmp = get_config ('horizontal_images');
204 if (scalar (@tmp) != 4)
206 print STDERR $/, __FILE__, ": The number of horizontal images is not four. The output might look weird.", $/;
209 for ($i = 0; $i < 4; $i++)
211 if (!defined ($tmp[$i]))
216 $H_IMAGES[$i] = $tmp[$i];
219 if (get_config ('bar_height'))
221 my $tmp = get_config ('bar_height');
223 $BAR_HEIGHT = $tmp if ($tmp >= 10);
225 if (get_config ('bar_width'))
227 my $tmp = get_config ('bar_width');
229 $BAR_WIDTH = $tmp if ($tmp >= 10);
231 if (get_config ('longlines'))
233 my $tmp = get_config ('longlines');
235 $LongLines = $tmp if ($tmp);
237 if (get_config ('shortlines'))
239 my $tmp = get_config ('shortlines');
241 if ($tmp or ($tmp == 0))
247 register_plugin ('TEXT', \&add);
248 register_plugin ('ACTION', \&add);
249 register_plugin ('OUTPUT', \&output);
251 my $VERSION = '$Id$';
252 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
260 my $nick = $data->{'nick'};
261 my $ident = $data->{'ident'};
262 my $hour = int ($data->{'hour'});
263 my $host = $data->{'host'};
264 my $text = $data->{'text'};
265 my $type = $data->{'type'};
266 my $time = $data->{'epoch'};
268 my $words = scalar (@{$data->{'words'}});
269 my $chars = length ($text);
271 if ($type eq 'ACTION')
273 $chars -= (length ($nick) + 3);
276 my @counter = $NickLinesCounter->get ($nick);
279 @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);
282 $NickLinesCounter->put ($nick, @counter);
284 @counter = $NickWordsCounter->get ($nick);
287 @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);
289 $counter[$hour] += $words;
290 $NickWordsCounter->put ($nick, @counter);
292 @counter = $NickCharsCounter->get ($nick);
295 @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);
297 $counter[$hour] += $chars;
298 $NickCharsCounter->put ($nick, @counter);
300 if ((length ($text) >= $QuoteMin)
301 and (length ($text) <= $QuoteMax))
303 if (!defined ($QuoteCache->{$nick}))
305 $QuoteCache->{$nick} = [];
307 push (@{$QuoteCache->{$nick}}, [$time, $text]);
310 if (defined ($QuoteCache->{$nick}))
312 while (scalar (@{$QuoteCache->{$nick}}) > $QuoteCacheSize)
314 shift (@{$QuoteCache->{$nick}});
323 for (get_all_nicks ())
326 my $main = get_main_nick ($nick);
328 if (!defined ($NickData->{$main}))
332 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)],
333 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)],
334 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)],
341 my @counter = $NickLinesCounter->get ($nick);
345 for (my $i = 0; $i < 24; $i++)
347 $NickData->{$main}{'lines'}[$i] += $counter[$i];
348 $sum += $counter[$i];
350 $NickData->{$main}{'lines_total'} = $sum;
353 @counter = $NickWordsCounter->get ($nick);
357 for (my $i = 0; $i < 24; $i++)
359 $NickData->{$main}{'words'}[$i] += $counter[$i];
360 $sum += $counter[$i];
362 $NickData->{$main}{'words_total'} = $sum;
365 @counter = $NickWordsCounter->get ($nick);
369 for (my $i = 0; $i < 24; $i++)
371 $NickData->{$main}{'words'}[$i] += $counter[$i];
372 $sum += $counter[$i];
374 $NickData->{$main}{'chars_total'} = $sum;
377 if (!defined ($QuoteData->{$main}))
379 $QuoteData->{$main} = [];
381 if (defined ($QuoteCache->{$nick}))
383 my @new = sort (sub { $b->[0] <=> $a->[0] }, @{$QuoteCache->{$nick}}, @{$QuoteData->{$main}});
384 splice (@new, $QuoteCacheSize) if (scalar (@new) > $QuoteCacheSize);
385 $QuoteData->{$main} = \@new;
399 my $max = 0; # the most lines that were written in one hour..
400 my $total = 0; # the total amount of lines we wrote..
401 my $factor = 0; # used to find a bar's height
403 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);
405 my @img_urls = get_config ('vertical_images');
408 @img_urls = qw#images/ver0n.png images/ver1n.png images/ver2n.png images/ver3n.png#;
411 my $fh = get_filehandle () or die;
413 # this for loop looks for the most amount of lines in one hour and sets
415 for (keys %$NickData)
419 for (my $i = 0; $i < 24; $i++)
421 $data[$i] += $NickData->{$nick}{'chars'}[$i];
425 for (my $i = 0; $i < 24; $i++)
427 $max = $data[$i] if ($max < $data[$i]);
437 $factor = (($BAR_HEIGHT - 1) / $max);
439 my $header = translate ('When do we actually talk here?');
440 print $fh "<h2>$header</h2>\n",
441 qq#<table class="hours_of_day">\n#,
444 # this for circles through the four colors. Each color represents six hours.
445 # (4 * 6 hours = 24 hours)
446 for (my $i = 0; $i <= 3; $i++)
448 for (my $j = 0; $j <= 5; $j++)
450 my $hour = (($i * 6) + $j);
451 if (!defined ($data[$hour]))
456 my $percent = 100 * ($data[$hour] / $total);
457 my $height = int ($data[$hour] * $factor) + 1;
458 my $img_url = $img_urls[$i];
460 print $fh ' <td>', sprintf ("%2.1f", $percent),
461 qq#%<br /><img src="$img_url" style="height: $height#,
462 qq#px;" alt="" /></td>\n#;
466 print $fh " </tr>\n",
467 qq# <tr class="hour_row">\n#;
468 print $fh map { " <td>$_</td>\n" } (0 .. 23);
469 print $fh " </tr>\n",
477 my @nicks = keys (%$NickData);
479 return unless (@nicks);
487 my $fh = get_filehandle () or die;
489 my $sort_field = lc ($SORT_BY);
494 ($tmp) = sort { $NickData->{$b}{'lines_total'} <=> $NickData->{$a}{'lines_total'} } (@nicks);
495 $max_lines = $NickData->{$tmp}{'lines_total'} || 0;
497 ($tmp) = sort { $NickData->{$b}{'words_total'} <=> $NickData->{$a}{'words_total'} } (@nicks);
498 $max_words = $NickData->{$tmp}{'words_total'} || 0;
500 ($tmp) = sort { $NickData->{$b}{'chars_total'} <=> $NickData->{$a}{'chars_total'} } (@nicks);
501 $max_chars = $NickData->{$tmp}{'chars_total'} || 0;
503 $trans = translate ('Most active nicks');
505 print $fh "<h2>$trans</h2>\n";
506 if ($SORT_BY eq 'LINES')
508 $trans = translate ('Nicks sorted by numbers of lines written');
510 elsif ($SORT_BY eq 'WORDS')
512 $trans = translate ('Nicks sorted by numbers of words written');
514 else # ($SORT_BY eq 'CHARS')
516 $trans = translate ('Nicks sorted by numbers of characters written');
518 print $fh "<p>($trans)</p>\n";
522 <table class="big_ranking">
524 <td class="invis"> </td>
528 $trans = translate ('Image');
529 print $fh " <th>$trans</th>\n";
533 $trans = translate ('Nick');
534 print $fh " <th>$trans</th>\n";
536 if ($DISPLAY_LINES ne 'NONE')
538 $trans = translate ('Number of Lines');
539 print $fh " <th>$trans</th>\n";
541 if ($DISPLAY_WORDS ne 'NONE')
543 $trans = translate ('Number of Words');
544 print $fh " <th>$trans</th>\n";
546 if ($DISPLAY_CHARS ne 'NONE')
548 $trans = translate ('Number of Characters');
549 print $fh " <th>$trans</th>\n";
553 $trans = translate ('When?');
554 print $fh " <th>$trans</th>\n";
557 $trans = translate ('Random Quote');
558 print $fh " <th>$trans</th>\n",
561 @$SortedNicklist = sort
563 $NickData->{$b}{"${sort_field}_total"} <=> $NickData->{$a}{"${sort_field}_total"}
568 for (@$SortedNicklist)
571 my $ident = nick_to_ident ($nick);
572 my $name = ident_to_name ($ident);
576 # As long as we didn't hit the
577 # $LongLines-limit we continue
579 if ($linescount <= $LongLines)
581 my $quote = translate ('-- no quote available --');
583 if (defined ($QuoteData->{$nick}))
585 my $num = scalar (@{$QuoteData->{$nick}});
586 my $rand = int (rand ($num));
587 $quote = html_escape ($QuoteData->{$nick}[$rand]);
595 $link = get_link ($name);
596 $image = get_image ($name);
597 $realname = get_realname ($name);
601 qq# <td class="numeration"># . $linescount . "</td>\n";
605 if ($DEFAULT_IMAGE and !$image)
607 $image = $DEFAULT_IMAGE;
610 print $fh qq# <td class="image">#;
615 print $fh qq#<a href="$link">#;
617 print $fh qq#<img src="$image" alt="$name" />#;
630 my $title = $realname;
633 $title = "User: $name; " if ($name);
634 $title .= "Ident: $ident";
636 print $fh qq# <td class="nick" title="$title">#;
640 print $fh qq#<a href="$link">$name</a></td>\n#
644 print $fh qq#$name</td>\n#;
647 if ($DISPLAY_LINES ne 'NONE')
649 print $fh qq# <td class="bar">#;
650 if (($DISPLAY_LINES eq 'BOTH') or ($DISPLAY_LINES eq 'BAR'))
652 my $code = bar ($max_lines, $NickData->{$nick}{'lines'});
655 print $fh ' ' if ($DISPLAY_LINES eq 'BOTH');
656 if (($DISPLAY_LINES eq 'BOTH') or ($DISPLAY_LINES eq 'NUMBER'))
658 print $fh $NickData->{$nick}{'lines_total'};
663 if ($DISPLAY_WORDS ne 'NONE')
665 print $fh qq# <td class="bar">#;
666 if (($DISPLAY_WORDS eq 'BOTH') or ($DISPLAY_WORDS eq 'BAR'))
668 my $code = bar ($max_words, $NickData->{$nick}{'words'});
671 print $fh ' ' if ($DISPLAY_WORDS eq 'BOTH');
672 if (($DISPLAY_WORDS eq 'BOTH') or ($DISPLAY_WORDS eq 'NUMBER'))
674 print $fh $NickData->{$nick}{'words_total'};
679 if ($DISPLAY_CHARS ne 'NONE')
681 print $fh qq# <td class="bar">#;
682 if (($DISPLAY_CHARS eq 'BOTH') or ($DISPLAY_CHARS eq 'BAR'))
684 my $code = bar ($max_chars, $NickData->{$nick}{'chars'});
687 print $fh ' ' if ($DISPLAY_CHARS eq 'BOTH');
688 if (($DISPLAY_CHARS eq 'BOTH') or ($DISPLAY_CHARS eq 'NUMBER'))
690 print $fh $NickData->{$nick}{'chars_total'};
697 my $code = bar ($NickData->{$nick}{'chars_total'}, $NickData->{$nick}{'chars'});
698 print $fh qq# <td class="bar">$code</td>\n#;
701 print $fh qq# <td class="quote">$quote</td>\n#,
704 if ($linescount == $LongLines)
706 print $fh "</table>\n\n";
710 # Ok, we have too many people to
711 # list them all so we start a
712 # smaller table and just list the
713 # names.. (Six names per line..)
714 elsif ($linescount <= ($LongLines + 6 * $ShortLines))
716 my $row_in_this_table = int (($linescount - $LongLines - 1) / 6);
717 my $col_in_this_table = ($linescount - $LongLines - 1) % 6;
720 if ($SORT_BY eq 'LINES')
722 $total = $NickData->{$nick}{'lines_total'};
724 elsif ($SORT_BY eq 'WORDS')
726 $total = $NickData->{$nick}{'words_total'};
728 else # ($SORT_BY eq 'CHARS')
730 $total = $NickData->{$nick}{'chars_total'};
733 my $title = $name ? get_realname ($name) : '';
736 $title = "User: $name; " if ($name);
737 $title .= "Ident: $ident";
740 if ($row_in_this_table == 0 and $col_in_this_table == 0)
742 $trans = translate ("They didn't write so much");
743 print $fh "<h2>$trans</h2>\n",
744 qq#<table class="small_ranking">\n#,
748 if ($col_in_this_table == 0 and $row_in_this_table != 0)
750 print $fh " </tr>\n",
754 print $fh qq# <td title="$title">$name ($total)</td>\n#;
756 if ($row_in_this_table == $ShortLines and $col_in_this_table == 5)
758 print $fh " </tr>\n",
763 # There is no else. There are
764 # just too many people around.
765 # I might add a "There are xyz
766 # unmentioned nicks"-line..
769 if (($linescount > $LongLines)
770 and ($linescount <= ($LongLines + 6 * $ShortLines)))
772 my $col = ($linescount - $LongLines - 1) % 6;
776 print $fh qq# <td> </td>\n#;
780 print $fh " </tr>\n";
783 if ($linescount != $LongLines)
785 print $fh "</table>\n\n";
789 # this is called by "&ranking ();" and prints the horizontal usage-bar in the
790 # detailed nick-table
796 confess () unless (ref ($source) eq 'ARRAY');
798 # BAR_WIDTH is a least 10
799 my $max_width = $BAR_WIDTH - 4;
806 if (!$max_num) { return ($retval); }
807 $factor = $max_width / $max_num;
809 for ($i = 0; $i < 4; $i++)
813 my $img = $H_IMAGES[$i];
815 for ($j = 0; $j < 6; $j++)
817 my $hour = ($i * 6) + $j;
818 $sum += $source->[$hour];
821 $width += int (0.5 + ($sum * $factor));
823 $retval .= qq#<img src="$img" style="width: # . $width . q#px"#;
824 if ($i == 0) { $retval .= qq# class="first"#; }
825 elsif ($i == 3) { $retval .= qq# class="last"#; }
826 $retval .= ' alt="" />';
832 =head1 EXPORTED FUNCTIONS
836 =item B<get_core_nick_counters> (I<$nick>)
838 Returns a hash-ref that containes all the nick-counters available. It looks
842 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)],
843 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)],
844 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)],
852 sub get_core_nick_counters
856 if (!defined ($NickData->{$nick}))
861 return ($NickData->{$nick});
864 =item B<get_sorted_nicklist> ()
866 Returns an array-ref that containes all nicks, sorted by the field given in the
871 sub get_sorted_nicklist
873 return ($SortedNicklist);
880 Florian octo Forster, E<lt>octo at verplant.orgE<gt>