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));
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.
53 our @H_IMAGES = qw#dark-theme/h-red.png dark-theme/h-blue.png dark-theme/h-yellow.png dark-theme/h-green.png#;
54 our $QuoteCacheSize = 10;
58 our $SORT_BY = 'LINES';
59 our $DISPLAY_LINES = 'BOTH';
60 our $DISPLAY_WORDS = 'NONE';
61 our $DISPLAY_CHARS = 'NONE';
62 our $DISPLAY_TIMES = 0;
63 our $DISPLAY_IMAGES = 0;
64 our $DEFAULT_IMAGE = '';
65 our $BAR_HEIGHT = 130;
70 if (get_config ('quote_cache_size'))
72 my $tmp = get_config ('quote_cache_size');
74 $QuoteCacheSize = $tmp if ($tmp);
76 if (get_config ('quote_min'))
78 my $tmp = get_config ('quote_min');
80 $QuoteMin = $tmp if ($tmp);
82 if (get_config ('quote_max'))
84 my $tmp = get_config ('quote_max');
86 $QuoteMax = $tmp if ($tmp);
88 if (get_config ('min_word_length'))
90 my $tmp = get_config ('min_word_length');
92 $WORD_LENGTH = $tmp if ($tmp);
94 if (get_config ('display_lines'))
96 my $tmp = get_config ('display_lines');
99 if (($tmp eq 'NONE') or ($tmp eq 'BAR') or ($tmp eq 'NUMBER') or ($tmp eq 'BOTH'))
101 $DISPLAY_LINES = $tmp;
105 $tmp = get_config ('display_lines');
106 print STDERR $/, __FILE__, ": ``display_lines'' has been set to the invalid value ``$tmp''. ",
107 $/, __FILE__, ": Valid values are ``none'', ``bar'', ``number'' and ``both''. Using default value ``both''.";
110 if (get_config ('display_words'))
112 my $tmp = get_config ('display_words');
115 if (($tmp eq 'NONE') or ($tmp eq 'BAR') or ($tmp eq 'NUMBER') or ($tmp eq 'BOTH'))
117 $DISPLAY_WORDS = $tmp;
121 $tmp = get_config ('display_words');
122 print STDERR $/, __FILE__, ": ``display_words'' has been set to the invalid value ``$tmp''. ",
123 $/, __FILE__, ": Valid values are ``none'', ``bar'', ``number'' and ``both''. Using default value ``none''.";
126 if (get_config ('display_chars'))
128 my $tmp = get_config ('display_chars');
131 if (($tmp eq 'NONE') or ($tmp eq 'BAR') or ($tmp eq 'NUMBER') or ($tmp eq 'BOTH'))
133 $DISPLAY_CHARS = $tmp;
137 $tmp = get_config ('display_chars');
138 print STDERR $/, __FILE__, ": ``display_chars'' has been set to the invalid value ``$tmp''. ",
139 $/, __FILE__, ": Valid values are ``none'', ``bar'', ``number'' and ``both''. Using default value ``none''.";
142 if (get_config ('display_times'))
144 my $tmp = get_config ('display_times');
146 if ($tmp =~ m/true|on|yes/i)
150 elsif ($tmp =~ m/false|off|no/i)
156 print STDERR $/, __FILE__, ": ``display_times'' has been set to the invalid value ``$tmp''. ",
157 $/, __FILE__, ": Valid values are ``true'' and ``false''. Using default value ``false''.";
160 if (get_config ('display_images'))
162 my $tmp = get_config ('display_images');
164 if ($tmp =~ m/true|on|yes/i)
168 elsif ($tmp =~ m/false|off|no/i)
174 print STDERR $/, __FILE__, ": ``display_times'' has been set to the invalid value ``$tmp''. ",
175 $/, __FILE__, ": Valid values are ``true'' and ``false''. Using default value ``false''.";
178 if (get_config ('default_image'))
180 $DEFAULT_IMAGE = get_config ('default_image');
182 if (get_config ('sort_by'))
184 my $tmp = get_config ('sort_by');
187 if (($tmp eq 'LINES') or ($tmp eq 'WORDS') or ($tmp eq 'CHARS'))
193 $tmp = get_config ('sort_by');
194 print STDERR $/, __FILE__, ": ``sort_by'' has been set to the invalid value ``$tmp''. ",
195 $/, __FILE__, ": Valid values are ``lines'' and ``words''. Using default value ``lines''.";
198 if (get_config ('horizontal_images'))
200 my @tmp = get_config ('horizontal_images');
203 if (scalar (@tmp) != 4)
205 print STDERR $/, __FILE__, ": The number of horizontal images is not four. The output might look weird.", $/;
208 for ($i = 0; $i < 4; $i++)
210 if (!defined ($tmp[$i]))
215 $H_IMAGES[$i] = $tmp[$i];
218 if (get_config ('bar_height'))
220 my $tmp = get_config ('bar_height');
222 $BAR_HEIGHT = $tmp if ($tmp >= 10);
224 if (get_config ('bar_width'))
226 my $tmp = get_config ('bar_width');
228 $BAR_WIDTH = $tmp if ($tmp >= 10);
230 if (get_config ('longlines'))
232 my $tmp = get_config ('longlines');
234 $LongLines = $tmp if ($tmp);
236 if (get_config ('shortlines'))
238 my $tmp = get_config ('shortlines');
240 if ($tmp or ($tmp == 0))
246 register_plugin ('TEXT', \&add);
247 register_plugin ('ACTION', \&add);
248 register_plugin ('OUTPUT', \&output);
250 my $VERSION = '$Id$';
251 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
259 my $nick = $data->{'nick'};
260 my $ident = $data->{'ident'};
261 my $hour = int ($data->{'hour'});
262 my $host = $data->{'host'};
263 my $text = $data->{'text'};
264 my $type = $data->{'type'};
265 my $time = $data->{'epoch'};
267 my $words = scalar (@{$data->{'words'}});
268 my $chars = length ($text);
270 if ($type eq 'ACTION')
272 $chars -= (length ($nick) + 3);
275 my @counter = $NickLinesCounter->get ($nick);
278 @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);
281 $NickLinesCounter->put ($nick, @counter);
283 @counter = $NickWordsCounter->get ($nick);
286 @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);
288 $counter[$hour] += $words;
289 $NickWordsCounter->put ($nick, @counter);
291 @counter = $NickCharsCounter->get ($nick);
294 @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);
296 $counter[$hour] += $chars;
297 $NickCharsCounter->put ($nick, @counter);
299 if ((length ($text) >= $QuoteMin)
300 and (length ($text) <= $QuoteMax))
302 if (!defined ($QuoteCache->{$nick}))
304 $QuoteCache->{$nick} = [];
306 push (@{$QuoteCache->{$nick}}, [$time, $text]);
309 if (defined ($QuoteCache->{$nick}))
311 while (scalar (@{$QuoteCache->{$nick}}) > $QuoteCacheSize)
313 shift (@{$QuoteCache->{$nick}});
322 for (get_all_nicks ())
325 my $main = get_main_nick ($nick);
327 if (!defined ($NickData->{$main}))
331 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)],
332 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)],
333 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)],
340 my @counter = $NickLinesCounter->get ($nick);
344 for (my $i = 0; $i < 24; $i++)
346 $NickData->{$main}{'lines'}[$i] += $counter[$i];
347 $sum += $counter[$i];
349 $NickData->{$main}{'lines_total'} = $sum;
352 @counter = $NickWordsCounter->get ($nick);
356 for (my $i = 0; $i < 24; $i++)
358 $NickData->{$main}{'words'}[$i] += $counter[$i];
359 $sum += $counter[$i];
361 $NickData->{$main}{'words_total'} = $sum;
364 @counter = $NickWordsCounter->get ($nick);
368 for (my $i = 0; $i < 24; $i++)
370 $NickData->{$main}{'words'}[$i] += $counter[$i];
371 $sum += $counter[$i];
373 $NickData->{$main}{'chars_total'} = $sum;
376 if (!defined ($QuoteData->{$main}))
378 $QuoteData->{$main} = [];
380 if (defined ($QuoteCache->{$nick}))
382 my @new = sort (sub { $b->[0] <=> $a->[0] }, @{$QuoteCache->{$nick}}, @{$QuoteData->{$main}});
383 splice (@new, $QuoteCacheSize) if (scalar (@new) > $QuoteCacheSize);
384 $QuoteData->{$main} = \@new;
398 my $max = 0; # the most lines that were written in one hour..
399 my $total = 0; # the total amount of lines we wrote..
400 my $factor = 0; # used to find a bar's height
402 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);
404 my @img_urls = get_config ('vertical_images');
407 @img_urls = qw#images/ver0n.png images/ver1n.png images/ver2n.png images/ver3n.png#;
410 my $fh = get_filehandle () or die;
412 # this for loop looks for the most amount of lines in one hour and sets
414 for (keys %$NickData)
418 for (my $i = 0; $i < 24; $i++)
420 $data[$i] += $NickData->{$nick}{'chars'}[$i];
424 for (my $i = 0; $i < 24; $i++)
426 $max = $data[$i] if ($max < $data[$i]);
436 $factor = (($BAR_HEIGHT - 1) / $max);
438 my $header = translate ('When do we actually talk here?');
439 print $fh "<h2>$header</h2>\n",
440 qq#<table class="hours_of_day">\n#,
443 # this for circles through the four colors. Each color represents six hours.
444 # (4 * 6 hours = 24 hours)
445 for (my $i = 0; $i <= 3; $i++)
447 for (my $j = 0; $j <= 5; $j++)
449 my $hour = (($i * 6) + $j);
450 if (!defined ($data[$hour]))
455 my $percent = 100 * ($data[$hour] / $total);
456 my $height = int ($data[$hour] * $factor) + 1;
457 my $img_url = $img_urls[$i];
459 print $fh ' <td>', sprintf ("%2.1f", $percent),
460 qq#%<br /><img src="$img_url" style="height: $height#,
461 qq#px;" alt="" /></td>\n#;
465 print $fh " </tr>\n",
466 qq# <tr class="hour_row">\n#;
467 print $fh map { " <td>$_</td>\n" } (0 .. 23);
468 print $fh " </tr>\n",
476 my @nicks = keys (%$NickData);
478 return unless (@nicks);
486 my $fh = get_filehandle () or die;
488 my $sort_field = lc ($SORT_BY);
493 ($tmp) = sort { $NickData->{$b}{'lines_total'} <=> $NickData->{$a}{'lines_total'} } (@nicks);
494 $max_lines = $NickData->{$tmp}{'lines_total'} || 0;
496 ($tmp) = sort { $NickData->{$b}{'words_total'} <=> $NickData->{$a}{'words_total'} } (@nicks);
497 $max_words = $NickData->{$tmp}{'words_total'} || 0;
499 ($tmp) = sort { $NickData->{$b}{'chars_total'} <=> $NickData->{$a}{'chars_total'} } (@nicks);
500 $max_chars = $NickData->{$tmp}{'chars_total'} || 0;
502 $trans = translate ('Most active nicks');
504 print $fh "<h2>$trans</h2>\n";
505 if ($SORT_BY eq 'LINES')
507 $trans = translate ('Nicks sorted by numbers of lines written');
509 elsif ($SORT_BY eq 'WORDS')
511 $trans = translate ('Nicks sorted by numbers of words written');
513 else # ($SORT_BY eq 'CHARS')
515 $trans = translate ('Nicks sorted by numbers of characters written');
517 print $fh "<p>($trans)</p>\n";
521 <table class="big_ranking">
523 <td class="invis"> </td>
527 $trans = translate ('Image');
528 print $fh " <th>$trans</th>\n";
532 $trans = translate ('Nick');
533 print $fh " <th>$trans</th>\n";
535 if ($DISPLAY_LINES ne 'NONE')
537 $trans = translate ('Number of Lines');
538 print $fh " <th>$trans</th>\n";
540 if ($DISPLAY_WORDS ne 'NONE')
542 $trans = translate ('Number of Words');
543 print $fh " <th>$trans</th>\n";
545 if ($DISPLAY_CHARS ne 'NONE')
547 $trans = translate ('Number of Characters');
548 print $fh " <th>$trans</th>\n";
552 $trans = translate ('When?');
553 print $fh " <th>$trans</th>\n";
556 $trans = translate ('Random Quote');
557 print $fh " <th>$trans</th>\n",
562 $NickData->{$b}{"${sort_field}_total"} <=> $NickData->{$a}{"${sort_field}_total"}
566 my $ident = nick_to_ident ($nick);
567 my $name = ident_to_name ($ident);
571 # As long as we didn't hit the
572 # $LongLines-limit we continue
574 if ($linescount <= $LongLines)
576 my $quote = translate ('-- no quote available --');
578 if (defined ($QuoteData->{$nick}))
580 my $num = scalar (@{$QuoteData->{$nick}});
581 my $rand = int (rand ($num));
582 $quote = html_escape ($QuoteData->{$nick}[$rand]);
590 $link = get_link ($name);
591 $image = get_image ($name);
592 $realname = get_realname ($name);
596 qq# <td class="numeration"># . $linescount . "</td>\n";
600 if ($DEFAULT_IMAGE and !$image)
602 $image = $DEFAULT_IMAGE;
605 print $fh qq# <td class="image">#;
610 print $fh qq#<a href="$link">#;
612 print $fh qq#<img src="$image" alt="$name" />#;
625 my $title = $realname;
628 $title = "User: $name; " if ($name);
629 $title .= "Ident: $ident";
631 print $fh qq# <td class="nick" title="$title">#;
635 print $fh qq#<a href="$link">$name</a></td>\n#
639 print $fh qq#$name</td>\n#;
642 if ($DISPLAY_LINES ne 'NONE')
644 print $fh qq# <td class="bar">#;
645 if (($DISPLAY_LINES eq 'BOTH') or ($DISPLAY_LINES eq 'BAR'))
647 my $code = bar ($max_lines, $NickData->{$nick}{'lines'});
650 print $fh ' ' if ($DISPLAY_LINES eq 'BOTH');
651 if (($DISPLAY_LINES eq 'BOTH') or ($DISPLAY_LINES eq 'NUMBER'))
653 print $fh $NickData->{$nick}{'lines_total'};
658 if ($DISPLAY_WORDS ne 'NONE')
660 print $fh qq# <td class="bar">#;
661 if (($DISPLAY_WORDS eq 'BOTH') or ($DISPLAY_WORDS eq 'BAR'))
663 my $code = bar ($max_words, $NickData->{$nick}{'words'});
666 print $fh ' ' if ($DISPLAY_WORDS eq 'BOTH');
667 if (($DISPLAY_WORDS eq 'BOTH') or ($DISPLAY_WORDS eq 'NUMBER'))
669 print $fh $NickData->{$nick}{'words_total'};
674 if ($DISPLAY_CHARS ne 'NONE')
676 print $fh qq# <td class="bar">#;
677 if (($DISPLAY_CHARS eq 'BOTH') or ($DISPLAY_CHARS eq 'BAR'))
679 my $code = bar ($max_chars, $NickData->{$nick}{'chars'});
682 print $fh ' ' if ($DISPLAY_CHARS eq 'BOTH');
683 if (($DISPLAY_CHARS eq 'BOTH') or ($DISPLAY_CHARS eq 'NUMBER'))
685 print $fh $NickData->{$nick}{'chars_total'};
692 my $code = bar ($NickData->{$nick}{'chars_total'}, $NickData->{$nick}{'chars'});
693 print $fh qq# <td class="bar">$code</td>\n#;
696 print $fh qq# <td class="quote">$quote</td>\n#,
699 if ($linescount == $LongLines)
701 print $fh "</table>\n\n";
705 # Ok, we have too many people to
706 # list them all so we start a
707 # smaller table and just list the
708 # names.. (Six names per line..)
709 elsif ($linescount <= ($LongLines + 6 * $ShortLines))
711 my $row_in_this_table = int (($linescount - $LongLines - 1) / 6);
712 my $col_in_this_table = ($linescount - $LongLines - 1) % 6;
715 if ($SORT_BY eq 'LINES')
717 $total = $NickData->{$nick}{'lines_total'};
719 elsif ($SORT_BY eq 'WORDS')
721 $total = $NickData->{$nick}{'words_total'};
723 else # ($SORT_BY eq 'CHARS')
725 $total = $NickData->{$nick}{'chars_total'};
728 my $title = $name ? get_realname ($name) : '';
731 $title = "User: $name; " if ($name);
732 $title .= "Ident: $ident";
735 if ($row_in_this_table == 0 and $col_in_this_table == 0)
737 $trans = translate ("They didn't write so much");
738 print $fh "<h2>$trans</h2>\n",
739 qq#<table class="small_ranking">\n#,
743 if ($col_in_this_table == 0 and $row_in_this_table != 0)
745 print $fh " </tr>\n",
749 print $fh qq# <td title="$title">$name ($total)</td>\n#;
751 if ($row_in_this_table == $ShortLines and $col_in_this_table == 5)
753 print $fh " </tr>\n",
758 # There is no else. There are
759 # just too many people around.
760 # I might add a "There are xyz
761 # unmentioned nicks"-line..
764 if (($linescount > $LongLines)
765 and ($linescount <= ($LongLines + 6 * $ShortLines)))
767 my $col = ($linescount - $LongLines - 1) % 6;
771 print $fh qq# <td> </td>\n#;
775 print $fh " </tr>\n";
778 if ($linescount != $LongLines)
780 print $fh "</table>\n\n";
784 # this is called by "&ranking ();" and prints the horizontal usage-bar in the
785 # detailed nick-table
792 confess unless (ref ($source eq 'ARRAY'));
794 # BAR_WIDTH is a least 10
795 my $max_width = $BAR_WIDTH - 4;
802 if (!$max_num) { return ($retval); }
803 $factor = $max_width / $max_num;
805 for ($i = 0; $i < 4; $i++)
809 my $img = $H_IMAGES[$i];
811 for ($j = 0; $j < 6; $j++)
813 my $hour = ($i * 6) + $j;
814 $sum += $source->[$hour];
817 $width += int (0.5 + ($sum * $factor));
819 $retval .= qq#<img src="$img" style="width: # . $width . q#px"#;
820 if ($i == 0) { $retval .= qq# class="first"#; }
821 elsif ($i == 3) { $retval .= qq# class="last"#; }
822 $retval .= ' alt="" />';
828 =head1 EXPORTED FUNCTIONS
832 =item B<get_core_nick_counters> (I<$nick>)
834 Returns the total I<lines>, I<words> and I<characters> written by the given
839 sub get_core_nick_counters
843 if (defined ($NickData->{$nick}))
845 return ($NickData->{$nick}{'lines_total'},
846 $NickData->{$nick}{'words_total'},
847 $NickData->{$nick}{'chars_total'});
857 Florian octo Forster, E<lt>octo at verplant.orgE<gt>