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 = $NickCharsCounter->get ($nick);
369 for (my $i = 0; $i < 24; $i++)
371 $NickData->{$main}{'chars'}[$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}))
384 push (@new, @{$QuoteData->{$main}}) if (@{$QuoteData->{$main}});
385 push (@new, @{$QuoteCache->{$nick}}) if (@{$QuoteCache->{$nick}});
387 @new = sort { $b->[0] <=> $a->[0] } (@new);
388 splice (@new, $QuoteCacheSize) if (scalar (@new) > $QuoteCacheSize);
390 $QuoteData->{$main} = \@new;
404 my $max = 0; # the most lines that were written in one hour..
405 my $total = 0; # the total amount of lines we wrote..
406 my $factor = 0; # used to find a bar's height
408 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);
410 my @img_urls = get_config ('vertical_images');
413 @img_urls = qw#images/ver0n.png images/ver1n.png images/ver2n.png images/ver3n.png#;
416 my $fh = get_filehandle () or die;
418 # this for loop looks for the most amount of lines in one hour and sets
420 for (keys %$NickData)
424 for (my $i = 0; $i < 24; $i++)
426 $data[$i] += $NickData->{$nick}{'chars'}[$i];
430 for (my $i = 0; $i < 24; $i++)
432 $max = $data[$i] if ($max < $data[$i]);
442 $factor = (($BAR_HEIGHT - 1) / $max);
444 my $header = translate ('When do we actually talk here?');
445 print $fh "<h2>$header</h2>\n",
446 qq#<table class="hours_of_day">\n#,
449 # this for circles through the four colors. Each color represents six hours.
450 # (4 * 6 hours = 24 hours)
451 for (my $i = 0; $i <= 3; $i++)
453 for (my $j = 0; $j <= 5; $j++)
455 my $hour = (($i * 6) + $j);
456 if (!defined ($data[$hour]))
461 my $percent = 100 * ($data[$hour] / $total);
462 my $height = int ($data[$hour] * $factor) + 1;
463 my $img_url = $img_urls[$i];
465 print $fh ' <td>', sprintf ("%2.1f", $percent),
466 qq#%<br /><img src="$img_url" style="height: $height#,
467 qq#px;" alt="" /></td>\n#;
471 print $fh " </tr>\n",
472 qq# <tr class="hour_row">\n#;
473 print $fh map { " <td>$_</td>\n" } (0 .. 23);
474 print $fh " </tr>\n",
482 my @nicks = keys (%$NickData);
484 return unless (@nicks);
492 my $fh = get_filehandle () or die;
494 my $sort_field = lc ($SORT_BY);
499 ($tmp) = sort { $NickData->{$b}{'lines_total'} <=> $NickData->{$a}{'lines_total'} } (@nicks);
500 $max_lines = $NickData->{$tmp}{'lines_total'} || 0;
502 ($tmp) = sort { $NickData->{$b}{'words_total'} <=> $NickData->{$a}{'words_total'} } (@nicks);
503 $max_words = $NickData->{$tmp}{'words_total'} || 0;
505 ($tmp) = sort { $NickData->{$b}{'chars_total'} <=> $NickData->{$a}{'chars_total'} } (@nicks);
506 $max_chars = $NickData->{$tmp}{'chars_total'} || 0;
508 $trans = translate ('Most active nicks');
510 print $fh "<h2>$trans</h2>\n";
511 if ($SORT_BY eq 'LINES')
513 $trans = translate ('Nicks sorted by numbers of lines written');
515 elsif ($SORT_BY eq 'WORDS')
517 $trans = translate ('Nicks sorted by numbers of words written');
519 else # ($SORT_BY eq 'CHARS')
521 $trans = translate ('Nicks sorted by numbers of characters written');
523 print $fh "<p>($trans)</p>\n";
527 <table class="big_ranking">
529 <td class="invis"> </td>
533 $trans = translate ('Image');
534 print $fh " <th>$trans</th>\n";
538 $trans = translate ('Nick');
539 print $fh " <th>$trans</th>\n";
541 if ($DISPLAY_LINES ne 'NONE')
543 $trans = translate ('Number of Lines');
544 print $fh " <th>$trans</th>\n";
546 if ($DISPLAY_WORDS ne 'NONE')
548 $trans = translate ('Number of Words');
549 print $fh " <th>$trans</th>\n";
551 if ($DISPLAY_CHARS ne 'NONE')
553 $trans = translate ('Number of Characters');
554 print $fh " <th>$trans</th>\n";
558 $trans = translate ('When?');
559 print $fh " <th>$trans</th>\n";
562 $trans = translate ('Random Quote');
563 print $fh " <th>$trans</th>\n",
566 @$SortedNicklist = sort
568 $NickData->{$b}{"${sort_field}_total"} <=> $NickData->{$a}{"${sort_field}_total"}
573 for (@$SortedNicklist)
576 my $ident = nick_to_ident ($nick);
577 my $name = ident_to_name ($ident);
578 my $print = $name || $nick;
582 # As long as we didn't hit the
583 # $LongLines-limit we continue
585 if ($linescount <= $LongLines)
587 my $quote = translate ('-- no quote available --');
589 if (@{$QuoteData->{$nick}})
591 my $num = scalar (@{$QuoteData->{$nick}});
592 my $rand = int (rand ($num));
594 require Data::Dumper;
595 print STDOUT Data::Dumper->Dump ([$rand, $QuoteData->{$nick}], ['rand', "QuoteData->{$nick}"]);
597 $quote = html_escape ($QuoteData->{$nick}[$rand][1]);
605 $link = get_link ($name);
606 $image = get_image ($name);
607 $realname = get_realname ($name);
611 qq# <td class="numeration"># . $linescount . "</td>\n";
615 if ($DEFAULT_IMAGE and !$image)
617 $image = $DEFAULT_IMAGE;
620 print $fh qq# <td class="image">#;
625 print $fh qq#<a href="$link">#;
627 print $fh qq#<img src="$image" alt="$name" />#;
640 my $title = $realname;
643 $title = "User: $name; " if ($name);
644 $title .= "Ident: $ident";
646 print $fh qq# <td class="nick" title="$title">#;
650 print $fh qq#<a href="$link">$print</a></td>\n#
654 print $fh qq#$print</td>\n#;
657 if ($DISPLAY_LINES ne 'NONE')
659 print $fh qq# <td class="bar">#;
660 if (($DISPLAY_LINES eq 'BOTH') or ($DISPLAY_LINES eq 'BAR'))
662 my $code = bar ($max_lines, $NickData->{$nick}{'lines'});
665 print $fh ' ' if ($DISPLAY_LINES eq 'BOTH');
666 if (($DISPLAY_LINES eq 'BOTH') or ($DISPLAY_LINES eq 'NUMBER'))
668 print $fh $NickData->{$nick}{'lines_total'};
673 if ($DISPLAY_WORDS ne 'NONE')
675 print $fh qq# <td class="bar">#;
676 if (($DISPLAY_WORDS eq 'BOTH') or ($DISPLAY_WORDS eq 'BAR'))
678 my $code = bar ($max_words, $NickData->{$nick}{'words'});
681 print $fh ' ' if ($DISPLAY_WORDS eq 'BOTH');
682 if (($DISPLAY_WORDS eq 'BOTH') or ($DISPLAY_WORDS eq 'NUMBER'))
684 print $fh $NickData->{$nick}{'words_total'};
689 if ($DISPLAY_CHARS ne 'NONE')
691 print $fh qq# <td class="bar">#;
692 if (($DISPLAY_CHARS eq 'BOTH') or ($DISPLAY_CHARS eq 'BAR'))
694 my $code = bar ($max_chars, $NickData->{$nick}{'chars'});
697 print $fh ' ' if ($DISPLAY_CHARS eq 'BOTH');
698 if (($DISPLAY_CHARS eq 'BOTH') or ($DISPLAY_CHARS eq 'NUMBER'))
700 print $fh $NickData->{$nick}{'chars_total'};
707 my $code = bar ($NickData->{$nick}{'chars_total'}, $NickData->{$nick}{'chars'});
708 print $fh qq# <td class="bar">$code</td>\n#;
711 print $fh qq# <td class="quote">$quote</td>\n#,
714 if ($linescount == $LongLines)
716 print $fh "</table>\n\n";
720 # Ok, we have too many people to
721 # list them all so we start a
722 # smaller table and just list the
723 # names.. (Six names per line..)
724 elsif ($linescount <= ($LongLines + 6 * $ShortLines))
726 my $row_in_this_table = int (($linescount - $LongLines - 1) / 6);
727 my $col_in_this_table = ($linescount - $LongLines - 1) % 6;
730 if ($SORT_BY eq 'LINES')
732 $total = $NickData->{$nick}{'lines_total'};
734 elsif ($SORT_BY eq 'WORDS')
736 $total = $NickData->{$nick}{'words_total'};
738 else # ($SORT_BY eq 'CHARS')
740 $total = $NickData->{$nick}{'chars_total'};
743 my $title = $name ? get_realname ($name) : '';
746 $title = "User: $name; " if ($name);
747 $title .= "Ident: $ident";
750 if ($row_in_this_table == 0 and $col_in_this_table == 0)
752 $trans = translate ("They didn't write so much");
753 print $fh "<h2>$trans</h2>\n",
754 qq#<table class="small_ranking">\n#,
758 if ($col_in_this_table == 0 and $row_in_this_table != 0)
760 print $fh " </tr>\n",
764 print $fh qq# <td title="$title">$print ($total)</td>\n#;
766 if ($row_in_this_table == $ShortLines and $col_in_this_table == 5)
768 print $fh " </tr>\n",
773 # There is no else. There are
774 # just too many people around.
775 # I might add a "There are xyz
776 # unmentioned nicks"-line..
779 if (($linescount > $LongLines)
780 and ($linescount <= ($LongLines + 6 * $ShortLines)))
782 my $col = ($linescount - $LongLines - 1) % 6;
786 print $fh qq# <td> </td>\n#;
790 print $fh " </tr>\n";
793 if ($linescount != $LongLines)
795 print $fh "</table>\n\n";
799 # this is called by "&ranking ();" and prints the horizontal usage-bar in the
800 # detailed nick-table
806 confess () unless (ref ($source) eq 'ARRAY');
808 # BAR_WIDTH is a least 10
809 my $max_width = $BAR_WIDTH - 4;
816 if (!$max_num) { return ($retval); }
817 $factor = $max_width / $max_num;
819 for ($i = 0; $i < 4; $i++)
823 my $img = $H_IMAGES[$i];
825 for ($j = 0; $j < 6; $j++)
827 my $hour = ($i * 6) + $j;
828 $sum += $source->[$hour];
831 $width += int (0.5 + ($sum * $factor));
833 $retval .= qq#<img src="$img" style="width: # . $width . q#px"#;
834 if ($i == 0) { $retval .= qq# class="first"#; }
835 elsif ($i == 3) { $retval .= qq# class="last"#; }
836 $retval .= ' alt="" />';
842 =head1 EXPORTED FUNCTIONS
846 =item B<get_core_nick_counters> (I<$nick>)
848 Returns a hash-ref that containes all the nick-counters available. It looks
852 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)],
853 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)],
854 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)],
862 sub get_core_nick_counters
866 if (!defined ($NickData->{$nick}))
871 return ($NickData->{$nick});
874 =item B<get_sorted_nicklist> ()
876 Returns an array-ref that containes all nicks, sorted by the field given in the
881 sub get_sorted_nicklist
883 return ($SortedNicklist);
890 Florian octo Forster, E<lt>octo at verplant.orgE<gt>