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->[0 .. ($max - 1)];
 150         my $nick_data = {};
 151
 152         for (@nicks)
 153         {
 154                 my $nick = $_;
 155
 156                 $nick_data->{$nick} = get_core_nick_counters ($nick);
 157                 $nick_data->{$nick}{'conversations'} = get_conversations ($nick);
 158                 $nick_data->{$nick}{'bignumbers'} = get_bignumbers ($nick);
 159                 $nick_data->{$nick}{'interestingnumbers'} = get_interestingnumbers ($nick);
 160
 161                 for (my $i = 0; $i < 12; $i++)
 162                 {
 163                         $num = $nick_data->{$nick}{'lines'}[2 * $i] + $nick_data->{$nick}{'lines'}[(2 * $i) + 1];
 164                         $max_time = $num if ($max_time < $num);
 165                 }
 166
 167                 for (keys %{$nick_data->{$nick}{'conversations'}})
 168                 {
 169                         my $other = $_;
 170                         my $ptr = $nick_data->{$nick}{'conversations'}{'nicks'}{$other};
 171                         $num = $ptr->[0] + $ptr->[1] + $ptr->[2] + $ptr->[3];
 172                         $max_conv = $num if ($max_conv < $num);
 173                 }
 174         }
 175
 176         my $time_factor = 0;
 177         my $conv_factor = 0;
 178
 179         if ($max_time)
 180         {
 181                 $time_factor = $BAR_HEIGHT / $max_time;
 182         }
 183
 184         if ($max_conv)
 185         {
 186                 $conv_factor = $BAR_WIDTH / $max_conv;
 187         }
 188
 189         print $fh qq#<table class="plugin userdetails">\n#,
 190         qq#  <tr>\n#,
 191         qq#    <th colspan="#, $DISPLAY_IMAGES ? 3 : 2, qq#">$trans</th>\n#,
 192         qq#  </tr>\n#;
 193
 194         for (@nicks)
 195         {
 196                 my $nick = $_;
 197                 my $name = nick_to_name ($nick);
 198                 my $print = $name ? $name : $nick;
 199                 my $ptr = $nick_data->{$nick};
 200
 201                 print $fh qq#  <tr>\n#,
 202                 qq#    <th colspan="#, $DISPLAY_IMAGES ? 3 : 2, qq#" class="nick">$print</th>\n#,
 203                 qq#  </tr>\n#,
 204                 qq#  <tr>\n#;
 205
 206                 if ($DISPLAY_IMAGES)
 207                 {
 208                         my $link = get_link ($name);
 209                         my $image = get_image ($name);
 210
 211                         if ($DEFAULT_IMAGE and !$image)
 212                         {
 213                                 $image = $DEFAULT_IMAGE;
 214                         }
 215
 216                         print $fh qq#    <td class="image" rowspan="2">#;
 217                         if ($image)
 218                         {
 219                                 if ($link)
 220                                 {
 221                                         print $fh qq#<a href="$link">#;
 222                                 }
 223                                 print $fh qq#<img src="$image" alt="$print" />#;
 224                                 if ($link)
 225                                 {
 226                                         print $fh "</a>";
 227                                 }
 228                         }
 229                         else
 230                         {
 231                                 print $fh '&nbsp;';
 232                         }
 233                         print $fh "</td>\n";
 234                 }
 235
 236                 print $fh qq#    <td class="counters">\n#;
 237
 238                 {
 239                         my $lines;
 240                         my $words;
 241                         my $chars;
 242
 243                         $lines = $ptr->{'lines_total'};
 244                         $trans = translate ('Has written %u lines');
 245                         printf $fh ("      $trans<br />\n", $lines);
 246
 247                         $words = $ptr->{'words_total'};
 248                         $trans = translate ('Has written %u words');
 249                         printf $fh ("      $trans<br />\n", $words);
 250
 251                         $chars = $ptr->{'chars_total'};
 252                         $trans = translate ('Has written %u chars');
 253                         printf $fh ("      $trans<br />\n", $chars);
 254
 255                         $num = $words / $lines;
 256                         $trans = translate ('Has written %.1f words per line');
 257                         printf $fh ("      $trans<br />\n", $num);
 258
 259                         $num = $chars / $lines;
 260                         $trans = translate ('Has written %.1f characters per line');
 261                         printf $fh ("      $trans<br />\n", $num);
 262                 }
 263
 264                 print $fh qq#    </td>\n    <td class="numbers">\n#;
 265
 266                 if (%{$ptr->{'interestingnumbers'}})
 267                 {
 268                         $trans = translate ('Has given %u ops');
 269                         printf $fh ("      $trans<br />\n", $ptr->{'interestingnumbers'}{'ops_given'});
 270
 271                         $trans = translate ('Has taken %u ops');
 272                         printf $fh ("      $trans<br />\n", $ptr->{'interestingnumbers'}{'ops_taken'});
 273
 274                         $trans = translate ('Has kicked out %u people');
 275                         printf $fh ("      $trans<br />\n", $ptr->{'interestingnumbers'}{'kicks_given'});
 276
 277                         $trans = translate ('Has been kicked out %u times');
 278                         printf $fh ("      $trans<br />\n", $ptr->{'interestingnumbers'}{'kicks_received'});
 279
 280                         $trans = translate ('Has performed %u actions');
 281                         printf $fh ("      $trans<br />\n", $ptr->{'interestingnumbers'}{'actions'});
 282                 }
 283
 284                 if (%{$ptr->{'bignumbers'}})
 285                 {
 286                         $num = 100 * $ptr->{'bignumbers'}{'questions'} / $ptr->{'lines_total'};
 287                         $trans = translate ("Question ratio: %.1f%%");
 288                         printf $fh ("      $trans<br />\n", $num);
 289
 290                         $num = 100 * $ptr->{'bignumbers'}{'uppercase'} / $ptr->{'lines_total'};
 291                         $trans = translate ("Uppercase ratio: %.1f%%");
 292                         printf $fh ("      $trans<br />\n", $num);
 293
 294                         $num = 100 * $ptr->{'bignumbers'}{'smiley_happy'} / $ptr->{'lines_total'};
 295                         $trans = translate ("Happy smiley ratio: %.1f%%");
 296                         printf $fh ("      $trans<br />\n", $num);
 297
 298                         $num = 100 * $ptr->{'bignumbers'}{'smiley_sad'} / $ptr->{'lines_total'};
 299                         $trans = translate ("Sad smiley ratio: %.1f%%");
 300                         printf $fh ("      $trans<br />\n", $num);
 301                 }
 302
 303                 # actions # TODO
 304                 # exclamation ratio # TODO
 305                 # # of nicks
 306                 #
 307                 # chats with
 308                 # lines per day
 309
 310                 print $fh qq#    </td>\n  </tr>\n  <tr>\n    <td class="houractivity">\n#;
 311
 312                 if (defined ($ptr->{'chars'}))
 313                 {
 314                         print $fh qq#      <table class="hours_of_day">\n        <tr>\n#;
 315
 316                         for (my $i = 0; $i < 12; $i++)
 317                         {
 318                                 my $hour = 2 * $i;
 319                                 $num = 0;
 320
 321                                 my $img = $V_IMAGES[int ($hour / 6)];
 322                                 my $height;
 323
 324                                 $num  = $ptr->{'chars'}[$hour];
 325                                 $num += $ptr->{'chars'}[$hour + 1];
 326
 327                                 $height = int (0.5 + ($time_factor * $num)) || 1;
 328
 329                                 print $fh qq#          <td><img src="$img" alt="$num chars" #,
 330                                 qq#style="height: ${height}px;" /></td>\n#;
 331                         }
 332
 333                         print $fh <<EOF;
 334         </tr>
 335         <tr class="hour_row">
 336           <td colspan="3">0-5</td>
 337           <td colspan="3">6-11</td>
 338           <td colspan="3">12-17</td>
 339           <td colspan="3">18-23</td>
 340         </tr>
 341       </table>
 342 EOF
 343                 }
 344                 else
 345                 {
 346                         print '&nbsp;';
 347                 }
 348
 349                 print $fh qq#    </td>\n    <td class="convpartners">\n#;
 350
 351                 if (%{$ptr->{'conversations'}})
 352                 {
 353                         my $i;
 354                         my @others = sort
 355                         {
 356                                 ($ptr->{'conversations'}{$b}{'nicks'}{$nick}[0]
 357                                         + $ptr->{'conversations'}{$b}{'nicks'}{$nick}[1]
 358                                         + $ptr->{'conversations'}{$b}{'nicks'}{$nick}[2]
 359                                         + $ptr->{'conversations'}{$b}{'nicks'}{$nick}[3])
 360                                 <=>
 361                                 ($ptr->{'conversations'}{$a}{'nicks'}{$nick}[0]
 362                                         + $ptr->{'conversations'}{$a}{'nicks'}{$nick}[1]
 363                                         + $ptr->{'conversations'}{$a}{'nicks'}{$nick}[2]
 364                                         + $ptr->{'conversations'}{$a}{'nicks'}{$nick}[3])
 365                         }
 366                         (keys %{$ptr->{'conversations'}});
 367
 368                         $trans = translate ('Talks to');
 369
 370                         print $fh <<EOF;
 371       <table>
 372         <tr>
 373           <td colspan="2">$trans:</td>
 374         </tr>
 375 EOF
 376
 377                         for (my $i = 0; $i < $PLUGIN_MAX and $i < scalar (@others); $i++)
 378                         {
 379                                 my $other = $others[$i];
 380                                 my $other_name = nick_to_name ($other) || $other;
 381                                 my $total = 0;
 382
 383                                 print $fh "        <tr>\n",
 384                                 qq#          <td class="nick">$other_name</td>\n#,
 385                                 qq#          <td class="bar">#;
 386
 387                                 for (my $k = 0; $k < 4; $k++)
 388                                 {
 389                                         my $img = $H_IMAGES[$k];
 390                                         my $width = int (0.5 + ($conv_factor * $ptr->{'conversations'}{$other}{'nicks'}{$nick}[$k])) || 1;
 391
 392                                         print $fh qq#<img src="$img" alt="" #;
 393                                         if ($k == 0)
 394                                         {
 395                                                 print $fh qq#class="first" #;
 396                                         }
 397                                         elsif ($k == 3)
 398                                         {
 399                                                 print $fh qq#class="last" #;
 400                                         }
 401                                         print $fh qq#style="width: ${width}px;" />#;
 402                                 }
 403
 404                                 print $fh "</td>\n        </tr>\n";
 405                         }
 406
 407                         print $fh "      </table>\n";
 408                 }
 409                 else
 410                 {
 411                         print $fh '&nbsp;';
 412                 }
 413         }
 414
 415         print $fh "</table>\n\n";
 416 }