lib/Onis/Plugins/Weekdays.pm

   1 package Onis::Plugins::Weekdays;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Onis::Config (qw(get_config));
   7 use Onis::Html (qw(get_filehandle));
   8 use Onis::Language (qw(translate));
   9 use Onis::Data::Core (qw(register_plugin get_main_nick nick_to_ident nick_to_name));
  10 use Onis::Data::Persistent ();
  11
  12 register_plugin ('TEXT', \&add);
  13 register_plugin ('ACTION', \&add);
  14 register_plugin ('OUTPUT', \&output);
  15
  16 our $WeekdayCache = Onis::Data::Persistent->new ('WeekdayCache', 'nick',
  17 qw(
  18         sun0 sun1 sun2 sun3
  19         mon0 mon1 mon2 mon3
  20         tue0 tue1 tue2 tue3
  21         wed0 wed1 wed2 wed3
  22         thu0 thu1 thu2 thu3
  23         fri0 fri1 fri2 fri3
  24         sat0 sat1 sat2 sat3
  25 ));
  26 our $WeekdayData = {};
  27 our @Weekdays = (qw(sun mon tue wed thu fri sat));
  28
  29 our $BarHeight = 130;
  30 if (get_config ('bar_height'))
  31 {
  32         my $tmp = get_config ('bar_height');
  33         $tmp =~ s/\D//g;
  34         $BarHeight = $tmp if ($tmp >= 10);
  35 }
  36
  37 our @VImages = get_config ('vertical_images');
  38 if (scalar (@VImages) != 4)
  39 {
  40         @VImages = qw#images/ver0n.png images/ver1n.png images/ver2n.png images/ver3n.png#;
  41 }
  42
  43 my $VERSION = '$Id$';
  44 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
  45
  46 return (1);
  47
  48 sub add
  49 {
  50         my $data = shift;
  51         my $nick = $data->{'nick'};
  52         my $time = $data->{'epoch'};
  53         my $hour = int ($data->{'hour'} / 6);
  54         my $chars = length ($data->{'text'});
  55         my $day   = (localtime ($time))[6];
  56         my $index = ($day * 4) + $hour;
  57
  58         my @data = $WeekdayCache->get ($nick);
  59         @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 0 0 0 0)) unless (@data);
  60         $data[$index] += $chars;
  61         $WeekdayCache->put ($nick, @data);
  62
  63         @data = $WeekdayCache->get ('<TOTAL>');
  64         @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 0 0 0 0)) unless (@data);
  65         $data[$index] += $chars;
  66         $WeekdayCache->put ('<TOTAL>', @data);
  67 }
  68
  69 sub calculate
  70 {
  71         for ($WeekdayCache->keys ())
  72         {
  73                 my $nick = $_;
  74                 my $main = $nick eq '<TOTAL>' ? '<TOTAL>' : get_main_nick ($nick);
  75                 my @data = $WeekdayCache->get ($nick);
  76
  77                 if (!defined ($WeekdayData->{$main}))
  78                 {
  79                         $WeekdayData->{$main} =
  80                         {
  81                                 sun => [0, 0, 0, 0],
  82                                 mon => [0, 0, 0, 0],
  83                                 tue => [0, 0, 0, 0],
  84                                 wed => [0, 0, 0, 0],
  85                                 thu => [0, 0, 0, 0],
  86                                 fri => [0, 0, 0, 0],
  87                                 sat => [0, 0, 0, 0]
  88                         };
  89                 }
  90
  91                 for (my $i = 0; $i < 7; $i++)
  92                 {
  93                         my $day = $Weekdays[$i];
  94                         for (my $j = 0; $j < 4; $j++)
  95                         {
  96                                 my $idx = ($i * 4) + $j;
  97                                 $WeekdayData->{$main}{$day}[$j] += $data[$idx];
  98                         }
  99                 }
 100         }
 101 }
 102
 103 sub output
 104 {
 105         calculate ();
 106         return (undef) unless (%$WeekdayData);
 107
 108         my @order =
 109         (
 110                 [1, 'mon', 'Monday'],
 111                 [2, 'tue', 'Tuesday'],
 112                 [3, 'wed', 'Wednesday'],
 113                 [4, 'thu', 'Thursday'],
 114                 [5, 'fri', 'Friday'],
 115                 [6, 'sat', 'Saturday'],
 116                 [0, 'sun', 'Sunday']
 117         );
 118
 119         my $data = $WeekdayData->{'<TOTAL>'};
 120
 121         my $fh = get_filehandle ();
 122
 123         my $max = 0;
 124         my $total = 0;
 125         my $bar_factor = 0;
 126
 127         for (@order)
 128         {
 129                 my ($num, $abbr, $name) = @$_;
 130                 my $sum = $data->{$abbr}[0] + $data->{$abbr}[1] + $data->{$abbr}[2] + $data->{$abbr}[3];
 131
 132                 $total += $sum;
 133                 $max = $sum if ($max < $sum);
 134         }
 135
 136         $bar_factor = $BarHeight / $max;
 137
 138         print $fh qq#<table class="plugin weekdays">\n  <tr class="bars">\n#;
 139         for (@order)
 140         {
 141                 my ($num, $abbr, $name) = @$_;
 142                 print $fh qq#    <td class="bar vertical $abbr">#;
 143                 for (my $i = 3; $i >= 0; $i--)
 144                 {
 145                         my $num = $data->{$abbr}[$i];
 146                         my $height = sprintf ("%.2f", (95 * $num / $max));
 147                         my $img = $VImages[$i];
 148                         my $class = '';
 149
 150                         $class = q( class="first") if ($i == 3);
 151                         $class = q( class="last") if ($i == 0);
 152
 153                         print $fh qq(<img src="$img" alt="" style="height: ${height}%;"$class />);
 154                 }
 155                 print $fh "</td>\n";
 156         }
 157         print $fh qq(  </tr>\n  <tr class="counter">\n);
 158         for (@order)
 159         {
 160                 my ($num, $abbr, $name) = @$_;
 161                 my $sum = $data->{$abbr}[0] + $data->{$abbr}[1] + $data->{$abbr}[2] + $data->{$abbr}[3];
 162                 my $pct = sprintf ("%.1f", (100 * $sum / $total));
 163                 print $fh qq(    <td class="counter $abbr">$pct%</td>\n);
 164         }
 165         print $fh qq(  </tr>\n  <tr class="numeration">\n);
 166         for (@order)
 167         {
 168                 my ($num, $abbr, $name) = @$_;
 169                 print $fh qq(    <td class="numeration $abbr">$name</td>\n);
 170         }
 171         print $fh "  </tr>\n</table>\n\n";
 172 }