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