lib/Onis/Plugins/Conversations.pm

   1 package Onis::Plugins::Conversations;
   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);
  10 use Onis::Users qw(ident_to_name);
  11 use Onis::Data::Persistent;
  12
  13 our $ConversationCache = Onis::Data::Persistent->new ('ConversationCache', 'partners', qw(time0 time1 time2 time3));
  14 our $ConversationData = {};
  15
  16 our @H_IMAGES = qw#dark-theme/h-red.png dark-theme/h-blue.png dark-theme/h-yellow.png dark-theme/h-green.png#;
  17 our $BAR_WIDTH  = 100;
  18
  19 if (get_config ('horizontal_images'))
  20 {
  21         my @tmp = get_config ('horizontal_images');
  22         my $i;
  23
  24         if (scalar (@tmp) != 4)
  25         {
  26                 print STDERR $/, __FILE__, ": The number of horizontal images is not four. The output might look weird.", $/;
  27         }
  28
  29         for ($i = 0; $i < 4; $i++)
  30         {
  31                 next unless (defined ($tmp[$i]));
  32                 $H_IMAGES[$i] = $tmp[$i];
  33         }
  34 }
  35 if (get_config ('bar_width'))
  36 {
  37         my $tmp = get_config ('bar_width');
  38         $tmp =~ s/\D//g;
  39         $BAR_WIDTH = 2 * $tmp if ($tmp >= 10);
  40 }
  41
  42 register_plugin ('TEXT', \&add);
  43 register_plugin ('OUTPUT', \&output);
  44
  45 my $VERSION = '$Id: Conversations.pm,v 1.7 2004/09/15 19:42:04 octo Exp $';
  46 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
  47
  48 return (1);
  49
  50 sub add
  51 {
  52         my $data = shift;
  53         my $text = $data->{'text'};
  54         my $nick = $data->{'nick'};
  55         my $ident = $data->{'ident'};
  56
  57         my $time = int ($data->{'hour'} / 6);
  58
  59         # <taken from lib/Onis/Plugins/Nicks.pm>
  60         my @potential_nicks = split (/[^\w\`\~\^\-\|\[\]]+/, $text);
  61         my $talk_to = '';
  62
  63         for (@potential_nicks)
  64         {
  65                 my $other_nick = $_;
  66                 my $other_ident = nick_to_ident ($other_nick);
  67
  68                 if ($other_ident)
  69                 {
  70                         $talk_to = $other_nick;
  71                         last;
  72                 }
  73         }
  74         # </taken>
  75
  76         if ($talk_to)
  77         {
  78                 my $key = "$nick:$talk_to";
  79                 my @data = $ConversationCache->get ($key);
  80                 @data = (0, 0, 0, 0) unless (@data);
  81
  82                 my $chars = length ($text);
  83
  84                 $data[$time] += $chars;
  85
  86                 $ConversationCache->put ($key, @data);
  87         }
  88 }
  89
  90 sub calculate
  91 {
  92         for ($ConversationCache->keys ())
  93         {
  94                 my $key = $_;
  95                 my ($nick_from, $nick_to) = split (m/:/, $key);
  96                 my @data = $ConversationCache->get ($key);
  97
  98                 $nick_from = get_main_nick ($nick_from);
  99                 $nick_to   = get_main_nick ($nick_to);
 100
 101                 next if (!$nick_from or !$nick_to or ($nick_from eq $nick_to));
 102
 103                 if ($ConversationData->{$nick_from}{$nick_to})
 104                 {
 105                         $ConversationData->{$nick_from}{$nick_to} =
 106                         {
 107                                 total => 0,
 108                                 nicks =>
 109                                 {
 110                                         $nick_from => [0, 0, 0, 0],
 111                                         $nick_to   => [0, 0, 0, 0]
 112                                 }
 113                         };
 114                         $ConversationData->{$nick_to}{$nick_from} = $ConversationData->{$nick_from}{$nick_to};
 115                 }
 116
 117                 for (my $i = 0; $i < 4; $i++)
 118                 {
 119                         $ConversationData->{$nick_from}{$nick_to}{'nicks'}{$nick_from}[$i] += $data[$i];
 120                         $ConversationData->{$nick_from}{$nick_to}{'total'} += $data[$i];
 121                 }
 122         }
 123 }
 124
 125 sub get_top
 126 {
 127         my $num = shift;
 128         my @data = ();
 129
 130         for (keys %$ConversationData)
 131         {
 132                 my $nick0 = $_;
 133
 134                 for (keys %{$ConversationData->{$nick0}})
 135                 {
 136                         my $nick1 = $_;
 137                         next unless ($nick0 lt $nick1);
 138
 139                         push (@data, [$ConversationData->{$nick0}{$nick1}{'total'}, $nick0, $nick1]);
 140                 }
 141         }
 142
 143         @data = sort { $b->[0] <=> $a->[0] } (@data);
 144         splice (@data, $num) if (scalar (@data) > $num);
 145
 146         return (@data);
 147 }
 148
 149 sub output
 150 {
 151         calculate ();
 152
 153         my $fh = get_filehandle ();
 154         my $title = translate ('Conversation partners');
 155
 156         my $max_num = 0;
 157         my $factor = 0;
 158
 159         my @img = get_config ('horizontal_images');
 160
 161         my @data = get_top (10);
 162         return (undef) unless (@data);
 163
 164         for (@data)
 165         {
 166                 my $nick0 = $_->[1];
 167                 my $nick1 = $_->[2];
 168                 my $rec = $ConversationData->{$nick0}{$nick1};
 169
 170                 my $sum0 = 0;
 171                 my $sum1 = 0;
 172
 173                 for (my $i = 0; $i < 4; $i++)
 174                 {
 175                         $sum0 += $rec->{'users'}{$nick0}[$i];
 176                         $sum1 += $rec->{'users'}{$nick1}[$i];
 177                 }
 178
 179                 $max_num = $sum0 if ($max_num < $sum0);
 180                 $max_num = $sum1 if ($max_num < $sum1);
 181         }
 182
 183         $factor = $BAR_WIDTH / $max_num;
 184
 185         print $fh <<EOF;
 186 <table class="plugin conversations">
 187   <tr>
 188     <th colspan="2">$title</th>
 189   </tr>
 190 EOF
 191         foreach (@data)
 192         {
 193                 my $nick0 = $_->[1];
 194                 my $nick1 = $_->[2];
 195                 my $name0 = nick_to_name ($nick0) || $nick0;
 196                 my $name1 = nick_to_name ($nick1) || $nick1;
 197                 my $rec = $ConversationData->{$nick0}{$nick1};
 198
 199                 print $fh <<EOF;
 200   <tr>
 201     <td class="nick left">$name0</td>
 202     <td class="nick right">$name1</td>
 203   </tr>
 204   <tr>
 205 EOF
 206
 207                 print $fh '    <td class="bar left">';
 208                 for (3, 2, 1, 0)
 209                 {
 210                         my $i = $img[$_];
 211                         my $w = int (0.5 + ($rec->{'users'}{$nick0}[$_] * $factor));
 212                         my $c = '';
 213                         $w ||= 1;
 214
 215                         $w = $w . 'px';
 216
 217                         if    ($_ == 3) { $c = qq# class="first"#; }
 218                         elsif ($_ == 0) { $c = qq# class="last"#;  }
 219
 220                         print $fh qq#<img src="$i" style="width: $w;"$c alt="" />#;
 221                 }
 222
 223                 print $fh qq#</td>\n    <td class="bar right">#;
 224
 225                 for (0, 1, 2, 3)
 226                 {
 227                         my $i = $img[$_];
 228                         my $w = int (0.5 + ($rec->{'users'}{$nick1}[$_] * $factor));
 229                         my $c = '';
 230                         $w ||= 1;
 231
 232                         $w = $w . 'px';
 233
 234                         if    ($_ == 0) { $c = qq# class="first"#; }
 235                         elsif ($_ == 3) { $c = qq# class="last"#;  }
 236
 237                         print $fh qq#<img src="$i" style="width: $w;"$c alt=""/>#;
 238                 }
 239                 print $fh "</td>\n  </tr>\n";
 240         }
 241
 242         print $fh "</table>\n\n";
 243 }