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::Data::Persistent;
  13
  14 =head1 NAME
  15
  16 Onis::Plugins::Conversations - Who talks with who
  17
  18 =head1 DESCRIPTION
  19
  20 This plugins tries to recignise conversations and counts the amount that people
  21 talk to each other.
  22
  23 =cut
  24
  25 @Onis::Plugins::Conversations::EXPORT_OK = (qw(get_conversations));
  26 @Onis::Plugins::Conversations::ISA = ('Exporter');
  27
  28 our $ConversationCache = Onis::Data::Persistent->new ('ConversationCache', 'partners', qw(time0 time1 time2 time3));
  29 our $ConversationData = {};
  30
  31 our @H_IMAGES = qw#dark-theme/h-red.png dark-theme/h-blue.png dark-theme/h-yellow.png dark-theme/h-green.png#;
  32 our $BAR_WIDTH  = 100;
  33
  34 if (get_config ('horizontal_images'))
  35 {
  36         my @tmp = get_config ('horizontal_images');
  37         my $i;
  38
  39         if (scalar (@tmp) != 4)
  40         {
  41                 print STDERR $/, __FILE__, ": The number of horizontal images is not four. The output might look weird.", $/;
  42         }
  43
  44         for ($i = 0; $i < 4; $i++)
  45         {
  46                 next unless (defined ($tmp[$i]));
  47                 $H_IMAGES[$i] = $tmp[$i];
  48         }
  49 }
  50 if (get_config ('bar_width'))
  51 {
  52         my $tmp = get_config ('bar_width');
  53         $tmp =~ s/\D//g;
  54         $BAR_WIDTH = 2 * $tmp if ($tmp >= 10);
  55 }
  56
  57 register_plugin ('TEXT', \&add);
  58 register_plugin ('OUTPUT', \&output);
  59
  60 my $VERSION = '$Id: Conversations.pm,v 1.7 2004/09/15 19:42:04 octo Exp $';
  61 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
  62
  63 return (1);
  64
  65 sub add
  66 {
  67         my $data = shift;
  68         my $text = $data->{'text'};
  69         my $nick = $data->{'nick'};
  70         my $ident = $data->{'ident'};
  71
  72         my $time = int ($data->{'hour'} / 6);
  73
  74         # <taken from lib/Onis/Plugins/Nicks.pm>
  75         my @potential_nicks = split (/[^\w\`\~\^\-\|\[\]]+/, $text);
  76         my $talk_to = '';
  77
  78         for (@potential_nicks)
  79         {
  80                 my $other_nick = $_;
  81                 my $other_ident = nick_to_ident ($other_nick);
  82
  83                 if ($other_ident)
  84                 {
  85                         $talk_to = $other_nick;
  86                         last;
  87                 }
  88         }
  89         # </taken>
  90
  91         if ($talk_to)
  92         {
  93                 my $key = "$nick:$talk_to";
  94                 my @data = $ConversationCache->get ($key);
  95                 @data = (0, 0, 0, 0) unless (@data);
  96
  97                 my $chars = length ($text);
  98
  99                 $data[$time] += $chars;
 100
 101                 $ConversationCache->put ($key, @data);
 102         }
 103 }
 104
 105 sub calculate
 106 {
 107         for ($ConversationCache->keys ())
 108         {
 109                 my $key = $_;
 110                 my ($nick_from, $nick_to) = split (m/:/, $key);
 111                 my @data = $ConversationCache->get ($key);
 112
 113                 $nick_from = get_main_nick ($nick_from);
 114                 $nick_to   = get_main_nick ($nick_to);
 115
 116                 next if (!$nick_from or !$nick_to);
 117                 next if ($nick_from eq $nick_to);
 118
 119                 if (!defined ($ConversationData->{$nick_from}{$nick_to}))
 120                 {
 121                         $ConversationData->{$nick_from}{$nick_to} =
 122                         {
 123                                 total => 0,
 124                                 nicks =>
 125                                 {
 126                                         $nick_from => [0, 0, 0, 0],
 127                                         $nick_to   => [0, 0, 0, 0]
 128                                 }
 129                         };
 130                         $ConversationData->{$nick_to}{$nick_from} = $ConversationData->{$nick_from}{$nick_to};
 131                 }
 132
 133                 for (my $i = 0; $i < 4; $i++)
 134                 {
 135                         $ConversationData->{$nick_from}{$nick_to}{'nicks'}{$nick_from}[$i] += $data[$i];
 136                         $ConversationData->{$nick_from}{$nick_to}{'total'} += $data[$i];
 137                 }
 138         }
 139 }
 140
 141 sub get_top
 142 {
 143         my $num = shift;
 144         my @data = ();
 145
 146         for (keys %$ConversationData)
 147         {
 148                 my $nick0 = $_;
 149
 150                 for (keys %{$ConversationData->{$nick0}})
 151                 {
 152                         my $nick1 = $_;
 153                         next unless ($nick0 lt $nick1);
 154
 155                         push (@data, [$ConversationData->{$nick0}{$nick1}{'total'}, $nick0, $nick1]);
 156                 }
 157         }
 158
 159         @data = sort { $b->[0] <=> $a->[0] } (@data);
 160         splice (@data, $num) if (scalar (@data) > $num);
 161
 162         return (@data);
 163 }
 164
 165 sub output
 166 {
 167         calculate ();
 168
 169         my $fh = get_filehandle ();
 170         my $title = translate ('Conversation partners');
 171
 172         my $max_num = 0;
 173         my $factor = 0;
 174
 175         my @img = get_config ('horizontal_images');
 176
 177         # FIXME
 178         my @data = get_top (10);
 179         return (undef) unless (@data);
 180
 181         for (@data)
 182         {
 183                 my $nick0 = $_->[1];
 184                 my $nick1 = $_->[2];
 185                 my $rec = $ConversationData->{$nick0}{$nick1};
 186
 187                 my $sum0 = 0;
 188                 my $sum1 = 0;
 189
 190                 for (my $i = 0; $i < 4; $i++)
 191                 {
 192                         $sum0 += $rec->{'nicks'}{$nick0}[$i];
 193                         $sum1 += $rec->{'nicks'}{$nick1}[$i];
 194                 }
 195
 196                 $max_num = $sum0 if ($max_num < $sum0);
 197                 $max_num = $sum1 if ($max_num < $sum1);
 198         }
 199
 200         $factor = $BAR_WIDTH / $max_num;
 201
 202         print $fh <<EOF;
 203 <table class="plugin conversations">
 204   <tr>
 205     <th colspan="2">$title</th>
 206   </tr>
 207 EOF
 208         foreach (@data)
 209         {
 210                 my $nick0 = $_->[1];
 211                 my $nick1 = $_->[2];
 212                 my $name0 = nick_to_name ($nick0) || $nick0;
 213                 my $name1 = nick_to_name ($nick1) || $nick1;
 214                 my $rec = $ConversationData->{$nick0}{$nick1};
 215
 216                 print $fh <<EOF;
 217   <tr>
 218     <td class="nick left">$name0</td>
 219     <td class="nick right">$name1</td>
 220   </tr>
 221   <tr>
 222 EOF
 223
 224                 print $fh '    <td class="bar left">';
 225                 for (3, 2, 1, 0)
 226                 {
 227                         my $i = $img[$_];
 228                         my $w = int (0.5 + ($rec->{'nicks'}{$nick0}[$_] * $factor));
 229                         my $c = '';
 230                         $w ||= 1;
 231
 232                         $w = $w . 'px';
 233
 234                         if    ($_ == 3) { $c = qq# class="first"#; }
 235                         elsif ($_ == 0) { $c = qq# class="last"#;  }
 236
 237                         print $fh qq#<img src="$i" style="width: $w;"$c alt="" />#;
 238                 }
 239
 240                 print $fh qq#</td>\n    <td class="bar right">#;
 241
 242                 for (0, 1, 2, 3)
 243                 {
 244                         my $i = $img[$_];
 245                         my $w = int (0.5 + ($rec->{'nicks'}{$nick1}[$_] * $factor));
 246                         my $c = '';
 247                         $w ||= 1;
 248
 249                         $w = $w . 'px';
 250
 251                         if    ($_ == 0) { $c = qq# class="first"#; }
 252                         elsif ($_ == 3) { $c = qq# class="last"#;  }
 253
 254                         print $fh qq#<img src="$i" style="width: $w;"$c alt=""/>#;
 255                 }
 256                 print $fh "</td>\n  </tr>\n";
 257         }
 258
 259         print $fh "</table>\n\n";
 260 }
 261
 262 =head1 EXPORTED FUNCTIONS
 263
 264 =over 4
 265
 266 =item B<get_conversations> (I<$nick>)
 267
 268 Returns a hashref to the conversations this nick was involved with. The layout
 269 is the following. I<$other> is the nick of the person I<$nick> chattet with.
 270 The arrays hold the number of characters written by the nick used as the key.
 271 The first field contains the characters for the hours 0-5, the second field
 272 holds 6-11 and so on.
 273
 274   {
 275     $other =>
 276     {
 277       total => 0,
 278       nicks =>
 279       {
 280         $nick  => [0, 0, 0, 0],
 281         $other => [0, 0, 0, 0]
 282       }
 283     },
 284     ...
 285   }
 286
 287 =cut
 288
 289 sub get_conversations
 290 {
 291         my $nick = shift;
 292
 293         if (!defined ($ConversationData->{$nick}))
 294         {
 295                 return ({});
 296         }
 297         else
 298         {
 299                 return ($ConversationData->{$nick});
 300         }
 301 }
 302
 303 =back
 304
 305 =head1 AUTHOR
 306
 307 Florian octo Forster, E<lt>octo at verplant.orgE<gt>
 308
 309 =cut