lib/Onis/Plugins/Conversations.pm

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