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