lib/Onis/Plugins/Userdetails.pm

   1 package Onis::Plugins::Userdetails;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Onis::Config (qw(get_config));
   7 use Onis::Html (qw(html_escape get_filehandle));
   8 use Onis::Language (qw(translate));
   9 use Onis::Data::Core (qw(get_main_nick register_plugin nick_to_name));
  10 use Onis::Users (qw(ident_to_name get_link get_image));
  11
  12 use Onis::Plugins::Core (qw(get_core_nick_counters get_sorted_nicklist));
  13 use Onis::Plugins::Conversations (qw(get_conversations));
  14 use Onis::Plugins::Bignumbers (qw(get_bignumbers));
  15 use Onis::Plugins::Interestingnumbers (qw(get_interestingnumbers));
  16
  17 our $DISPLAY_IMAGES = 0;
  18 our $DEFAULT_IMAGE = '';
  19
  20 register_plugin ('OUTPUT', \&output);
  21
  22 our $SORT_BY = 'lines';
  23 if (get_config ('sort_by'))
  24 {
  25         my $tmp = get_config ('sort_by');
  26         $tmp = lc ($tmp);
  27
  28         if (($tmp eq 'lines') or ($tmp eq 'words') or ($tmp eq 'chars'))
  29         {
  30                 $SORT_BY = $tmp;
  31         }
  32         else
  33         {
  34                 # The Core plugin already complained about this..
  35         }
  36 }
  37 our $PLUGIN_MAX = 10;
  38 if (get_config ('plugin_max'))
  39 {
  40         my $tmp = get_config ('plugin_max');
  41         $tmp =~ s/\D//g;
  42         $PLUGIN_MAX = $tmp if ($tmp);
  43 }
  44 if (get_config ('display_images'))
  45 {
  46         my $tmp = get_config ('display_images');
  47
  48         if ($tmp =~ m/true|on|yes/i)
  49         {
  50                 $DISPLAY_IMAGES = 1;
  51         }
  52         elsif ($tmp =~ m/false|off|no/i)
  53         {
  54                 $DISPLAY_IMAGES = 0;
  55         }
  56         else
  57         {
  58                 print STDERR $/, __FILE__, ": ``display_times'' has been set to the invalid value ``$tmp''. ",
  59                 $/, __FILE__, ": Valid values are ``true'' and ``false''. Using default value ``false''.";
  60         }
  61 }
  62 if (get_config ('default_image'))
  63 {
  64         $DEFAULT_IMAGE = get_config ('default_image');
  65 }
  66
  67 our @H_IMAGES = qw#dark-theme/h-red.png dark-theme/h-blue.png dark-theme/h-yellow.png dark-theme/h-green.png#;
  68 if (get_config ('horizontal_images'))
  69 {
  70         my @tmp = get_config ('horizontal_images');
  71         my $i;
  72
  73         if (scalar (@tmp) != 4)
  74         {
  75                 # Do nothing:
  76                 # The core-pligin already complained about this..
  77         }
  78
  79         for ($i = 0; $i < 4; $i++)
  80         {
  81                 if (!defined ($tmp[$i]))
  82                 {
  83                         next;
  84                 }
  85
  86                 $H_IMAGES[$i] = $tmp[$i];
  87         }
  88 }
  89
  90 our @V_IMAGES = qw#images/ver0n.png images/ver1n.png images/ver2n.png images/ver3n.png#;
  91 if (get_config ('vertical_images'))
  92 {
  93         my @tmp = get_config ('vertical_images');
  94         my $i;
  95
  96         if (scalar (@tmp) != 4)
  97         {
  98                 # Do nothing:
  99                 # Hopefully someone complained by now..
 100         }
 101
 102         for ($i = 0; $i < 4; $i++)
 103         {
 104                 if (!defined ($tmp[$i]))
 105                 {
 106                         next;
 107                 }
 108
 109                 $V_IMAGES[$i] = $tmp[$i];
 110         }
 111 }
 112
 113 our $BAR_HEIGHT = 130;
 114 if (get_config ('bar_height'))
 115 {
 116         my $tmp = get_config ('bar_height');
 117         $tmp =~ s/\D//g;
 118         $BAR_HEIGHT = $tmp if ($tmp >= 10);
 119 }
 120 #$BAR_HEIGHT = int ($BAR_HEIGHT / 2);
 121
 122 our $BAR_WIDTH  = 100;
 123 if (get_config ('bar_width'))
 124 {
 125         my $tmp = get_config ('bar_width');
 126         $tmp =~ s/\D//g;
 127         $BAR_WIDTH = $tmp if ($tmp >= 10);
 128 }
 129
 130 my $VERSION = '$Id: Userdetails.pm,v 1.5 2005/03/14 18:40:25 octo Exp $';
 131 print STDERR $/, __FILE__, ": $VERSION" if ($::DEBUG);
 132
 133 return (1);
 134
 135 sub output
 136 {
 137         my $nicks_ref = get_sorted_nicklist ();
 138
 139         my $max = $PLUGIN_MAX;
 140
 141         my $fh = get_filehandle ();
 142
 143         my $trans = translate ('Detailed nick stats');
 144         my $num;
 145
 146         my $max_time = 0;
 147         my $max_conv = 0;
 148
 149         my @nicks = @$nicks_ref;
 150         my $nick_data = {};
 151
 152         splice (@nicks, $max) if (scalar (@nicks) > $max);
 153
 154         for (@nicks)
 155         {
 156                 my $nick = $_;
 157
 158                 $nick_data->{$nick} = get_core_nick_counters ($nick);
 159                 $nick_data->{$nick}{'conversations'} = get_conversations ($nick);
 160                 $nick_data->{$nick}{'bignumbers'} = get_bignumbers ($nick);
 161                 $nick_data->{$nick}{'interestingnumbers'} = get_interestingnumbers ($nick);
 162
 163                 for (my $i = 0; $i < 12; $i++)
 164                 {
 165                         $num = $nick_data->{$nick}{'chars'}[2 * $i] + $nick_data->{$nick}{'chars'}[(2 * $i) + 1];
 166                         $max_time = $num if ($max_time < $num);
 167                 }
 168
 169                 for (keys %{$nick_data->{$nick}{'conversations'}})
 170                 {
 171                         my $other = $_;
 172                         my $ptr = $nick_data->{$nick}{'conversations'}{$other}{'nicks'}{$nick};
 173                         $num = $ptr->[0] + $ptr->[1] + $ptr->[2] + $ptr->[3];
 174                         $max_conv = $num if ($max_conv < $num);
 175                 }
 176         }
 177
 178         my $time_factor = 0;
 179         my $conv_factor = 0;
 180
 181         if ($max_time)
 182         {
 183                 $time_factor = $BAR_HEIGHT / $max_time;
 184         }
 185
 186         if ($max_conv)
 187         {
 188                 $conv_factor = $BAR_WIDTH / $max_conv;
 189         }
 190
 191         print $fh qq#<table class="plugin userdetails">\n#,
 192         qq#  <tr>\n#,
 193         qq#    <th colspan="#, $DISPLAY_IMAGES ? 3 : 2, qq#">$trans</th>\n#,
 194         qq#  </tr>\n#;
 195
 196         for (@nicks)
 197         {
 198                 my $nick = $_;
 199                 my $name = nick_to_name ($nick);
 200                 my $print = $name ? $name : $nick;
 201                 my $ptr = $nick_data->{$nick};
 202
 203                 print $fh qq#  <tr>\n#,
 204                 qq#    <th colspan="#, $DISPLAY_IMAGES ? 3 : 2, qq#" class="nick">$print</th>\n#,
 205                 qq#  </tr>\n#,
 206                 qq#  <tr>\n#;
 207
 208                 if ($DISPLAY_IMAGES)
 209                 {
 210                         my $link = get_link ($name);
 211                         my $image = get_image ($name);
 212
 213                         if ($DEFAULT_IMAGE and !$image)
 214                         {
 215                                 $image = $DEFAULT_IMAGE;
 216                         }
 217
 218                         print $fh qq#    <td class="image" rowspan="2">#;
 219                         if ($image)
 220                         {
 221                                 if ($link)
 222                                 {
 223                                         print $fh qq#<a href="$link">#;
 224                                 }
 225                                 print $fh qq#<img src="$image" alt="$print" />#;
 226                                 if ($link)
 227                                 {
 228                                         print $fh "</a>";
 229                                 }
 230                         }
 231                         else
 232                         {
 233                                 print $fh '&nbsp;';
 234                         }
 235                         print $fh "</td>\n";
 236                 }
 237
 238                 print $fh qq#    <td class="counters">\n#;
 239
 240                 {
 241                         my $lines;
 242                         my $words;
 243                         my $chars;
 244
 245                         $lines = $ptr->{'lines_total'};
 246                         $trans = translate ('Has written %u lines');
 247                         printf $fh ("      $trans<br />\n", $lines);
 248
 249                         $words = $ptr->{'words_total'};
 250                         $trans = translate ('Has written %u words');
 251                         printf $fh ("      $trans<br />\n", $words);
 252
 253                         $chars = $ptr->{'chars_total'};
 254                         $trans = translate ('Has written %u chars');
 255                         printf $fh ("      $trans<br />\n", $chars);
 256
 257                         $lines ||= 1;
 258
 259                         $num = $words / $lines;
 260                         $trans = translate ('Has written %.1f words per line');
 261                         printf $fh ("      $trans<br />\n", $num);
 262
 263                         $num = $chars / $lines;
 264                         $trans = translate ('Has written %.1f characters per line');
 265                         printf $fh ("      $trans<br />\n", $num);
 266                 }
 267
 268                 print $fh qq#    </td>\n    <td class="numbers">\n#;
 269
 270                 if (%{$ptr->{'interestingnumbers'}})
 271                 {
 272                         $trans = translate ('Has given %u ops');
 273                         printf $fh ("      $trans<br />\n", $ptr->{'interestingnumbers'}{'op_given'});
 274
 275                         $trans = translate ('Has taken %u ops');
 276                         printf $fh ("      $trans<br />\n", $ptr->{'interestingnumbers'}{'op_taken'});
 277
 278                         $trans = translate ('Has kicked out %u people');
 279                         printf $fh ("      $trans<br />\n", $ptr->{'interestingnumbers'}{'kick_given'});
 280
 281                         $trans = translate ('Has been kicked out %u times');
 282                         printf $fh ("      $trans<br />\n", $ptr->{'interestingnumbers'}{'kick_received'});
 283
 284                         $trans = translate ('Has performed %u actions');
 285                         printf $fh ("      $trans<br />\n", $ptr->{'interestingnumbers'}{'actions'});
 286                 }
 287
 288                 if (%{$ptr->{'bignumbers'}})
 289                 {
 290                         $num = 100 * $ptr->{'bignumbers'}{'questions'} / $ptr->{'lines_total'};
 291                         $trans = translate ("Question ratio: %.1f%%");
 292                         printf $fh ("      $trans<br />\n", $num);
 293
 294                         $num = 100 * $ptr->{'bignumbers'}{'uppercase'} / $ptr->{'lines_total'};
 295                         $trans = translate ("Uppercase ratio: %.1f%%");
 296                         printf $fh ("      $trans<br />\n", $num);
 297
 298                         $num = 100 * $ptr->{'bignumbers'}{'smiley_happy'} / $ptr->{'lines_total'};
 299                         $trans = translate ("Happy smiley ratio: %.1f%%");
 300                         printf $fh ("      $trans<br />\n", $num);
 301
 302                         $num = 100 * $ptr->{'bignumbers'}{'smiley_sad'} / $ptr->{'lines_total'};
 303                         $trans = translate ("Sad smiley ratio: %.1f%%");
 304                         printf $fh ("      $trans<br />\n", $num);
 305                 }
 306
 307                 # actions # TODO
 308                 # exclamation ratio # TODO
 309                 # # of nicks
 310                 #
 311                 # chats with
 312                 # lines per day
 313
 314                 print $fh qq#    </td>\n  </tr>\n  <tr>\n    <td class="houractivity">\n#;
 315
 316                 if (defined ($ptr->{'chars'}))
 317                 {
 318                         print $fh qq#      <table class="hours_of_day">\n        <tr>\n#;
 319
 320                         for (my $i = 0; $i < 12; $i++)
 321                         {
 322                                 my $hour = 2 * $i;
 323                                 $num = 0;
 324
 325                                 my $img = $V_IMAGES[int ($hour / 6)];
 326                                 my $height;
 327
 328                                 $num  = $ptr->{'chars'}[$hour];
 329                                 $num += $ptr->{'chars'}[$hour + 1];
 330
 331                                 $height = int (0.5 + ($time_factor * $num)) || 1;
 332
 333                                 print $fh qq#          <td><img src="$img" alt="$num chars" #,
 334                                 qq#style="height: ${height}px;" /></td>\n#;
 335                         }
 336
 337                         print $fh <<EOF;
 338         </tr>
 339         <tr class="hour_row">
 340           <td colspan="3">0-5</td>
 341           <td colspan="3">6-11</td>
 342           <td colspan="3">12-17</td>
 343           <td colspan="3">18-23</td>
 344         </tr>
 345       </table>
 346 EOF
 347                 }
 348                 else
 349                 {
 350                         print '&nbsp;';
 351                 }
 352
 353                 print $fh qq#    </td>\n    <td class="convpartners">\n#;
 354
 355                 if (%{$ptr->{'conversations'}})
 356                 {
 357                         my $i;
 358                         my @others = sort
 359                         {
 360                                 ($ptr->{'conversations'}{$b}{'nicks'}{$nick}[0]
 361                                         + $ptr->{'conversations'}{$b}{'nicks'}{$nick}[1]
 362                                         + $ptr->{'conversations'}{$b}{'nicks'}{$nick}[2]
 363                                         + $ptr->{'conversations'}{$b}{'nicks'}{$nick}[3])
 364                                 <=>
 365                                 ($ptr->{'conversations'}{$a}{'nicks'}{$nick}[0]
 366                                         + $ptr->{'conversations'}{$a}{'nicks'}{$nick}[1]
 367                                         + $ptr->{'conversations'}{$a}{'nicks'}{$nick}[2]
 368                                         + $ptr->{'conversations'}{$a}{'nicks'}{$nick}[3])
 369                         }
 370                         (keys %{$ptr->{'conversations'}});
 371
 372                         $trans = translate ('Talks to');
 373
 374                         print $fh <<EOF;
 375       <table>
 376         <tr>
 377           <td colspan="2">$trans:</td>
 378         </tr>
 379 EOF
 380
 381                         for (my $i = 0; $i < $PLUGIN_MAX and $i < scalar (@others); $i++)
 382                         {
 383                                 my $other = $others[$i];
 384                                 my $other_name = nick_to_name ($other) || $other;
 385                                 my $total = 0;
 386
 387                                 print $fh "        <tr>\n",
 388                                 qq#          <td class="nick">$other_name</td>\n#,
 389                                 qq#          <td class="bar">#;
 390
 391                                 for (my $k = 0; $k < 4; $k++)
 392                                 {
 393                                         my $img = $H_IMAGES[$k];
 394                                         my $width = int (0.5 + ($conv_factor * $ptr->{'conversations'}{$other}{'nicks'}{$nick}[$k])) || 1;
 395
 396                                         print $fh qq#<img src="$img" alt="" #;
 397                                         if ($k == 0)
 398                                         {
 399                                                 print $fh qq#class="first" #;
 400                                         }
 401                                         elsif ($k == 3)
 402                                         {
 403                                                 print $fh qq#class="last" #;
 404                                         }
 405                                         print $fh qq#style="width: ${width}px;" />#;
 406                                 }
 407
 408                                 print $fh "</td>\n        </tr>\n";
 409                         }
 410
 411                         print $fh "      </table>\n";
 412                 }
 413                 else
 414                 {
 415                         print $fh '&nbsp;';
 416                 }
 417         }
 418
 419         print $fh "</table>\n\n";
 420 }