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