package Pisg::HTMLGenerator;
# Extra sections for the stats page, added to Pisg::HTMLGenerator:
#
# overview key numbers at a glance
# relations who talks to whom: interactive map, closest pairs, social roles
# time personalities night owls, early birds ...
# concentration how much of the channel the top talkers write
# signature words the word each regular owns
# navbar a sticky bar to jump to any section
#
# Everything here reads data pisg already collected (plus who-talks-to-whom from
# Pisg::Parser::Logfile). Each section has its own Show... option.
use strict;
use warnings;
use Pisg::Common;
use JSON::PP ();
use Encode ();
my @BUCKET_KEYS = qw(rel_time0 rel_time1 rel_time2 rel_time3);
# ---- small helpers ---------------------------------------------------------------
# Run one of the extra sections; if it fails, say so and carry on. The rest of the page
# is more important than any one extra section.
sub _ins_safe
{
my ($self, $method) = @_;
return if eval { $self->$method(); 1 };
my $err = $@;
$err =~ s/\s+$//;
print STDERR "Warning: skipped the '$method' section: $err\n";
}
sub _ins_num
{
my ($self, $n) = @_;
$n = int($n + 0.5);
1 while $n =~ s/^(-?\d+)(\d{3})/$1,$2/;
return $n;
}
sub _ins_esc { my ($self, $t) = @_; return htmlentities($t, $self->{cfg}->{charset}); }
# A "word" needs at least two real letters: ASCII art, punctuation and lone symbols are not words.
sub _has_letters
{
my ($self, $w) = @_;
my $u = eval { Encode::decode('UTF-8', $w, Encode::FB_CROAK | Encode::LEAVE_SRC) };
$u = $w unless defined $u;
return $u =~ /\p{L}{2}/ ? 1 : 0;
}
sub _ins_isbot
{
my ($self, $nick) = @_;
return 1 if is_ignored($nick);
my $sex = $self->{users}->{sex}{$nick};
return ($sex && $sex eq 'b') ? 1 : 0;
}
# Nicks that are people (not ignored, not marked as bots), busiest first.
sub _ins_humans
{
my $self = shift;
return $self->{ins_humans} ||= do {
my $l = $self->{stats}->{lines};
[ sort { $l->{$b} <=> $l->{$a} or $a cmp $b } grep { !$self->_ins_isbot($_) } keys %$l ];
};
}
# How many lines a nick needs before we rank it on things like "night owl".
sub _ins_minlines
{
my $self = shift;
my $t = $self->{cfg}->{bignumbersthreshold};
$t = 0 unless defined $t and $t =~ /^\d+(?:\.\d+)?$/;
return $t < 20 ? 20 : ($t > 100 ? 100 : $t);
}
sub _ins_json
{
my ($self, $data) = @_;
# Bytes in, bytes out (no utf8 layer), like the rest of the page. The escapes stop
# anything in a nick from closing the ');
$self->{ins_script_relmap} = 1;
$self->_insights_pairs;
$self->_insights_roles;
}
sub _insights_pairs
{
my $self = shift;
my $r = $self->_ins_relations;
my @top = sort { $b->{w} <=> $a->{w} or $a->{a} cmp $b->{a} } values %{ $r->{pair} };
my $max = $self->{cfg}->{nickhistory} > 10 ? $self->{cfg}->{nickhistory} : 10;
splice(@top, $max) if @top > $max;
return unless @top;
$self->_headline($self->_template_text('pairstopic'), 'pairs');
_html('
| | '
. '' . $self->_template_text('pair') . ' | '
. '' . $self->_template_text('rel_strength') . ' | '
. '' . $self->_template_text('pair_detail') . ' |
');
my $i = 0;
for my $p (@top) {
$i++;
my $wid = int(100 * $p->{w} / $top[0]{w});
my ($ab, $ba) = ($p->{ab}, $p->{ba});
my $detail = $self->_template_text('pair_line', a => $self->_ins_esc($p->{a}), b => $self->_ins_esc($p->{b}),
ad => $ab->[0], am => $ab->[1], bd => $ba->[0], bm => $ba->[1], replies => $ab->[2] + $ba->[2]);
_html('| ' . $i . ' | '
. '' . $self->_ins_esc($p->{a}) . ' ↔ ' . $self->_ins_esc($p->{b}) . ' | '
. ' ' . $self->_ins_num($p->{w}) . ' | '
. '' . $detail . ' |
');
}
_html('
');
}
sub _insights_roles
{
my $self = shift;
my $st = $self->{stats};
my $r = $self->_ins_relations;
my $min = $self->_ins_minlines;
my @pool = grep { $st->{lines}{$_} >= $min } @{ $self->_ins_humans };
return unless @pool >= 3;
my $best = sub {
my ($score, $desc) = @_; # highest score wins
my ($win, $ws) = (undef, undef);
for my $n (@pool) {
my $s = $score->($n);
($win, $ws) = ($n, $s) if defined $s and (!defined $ws or $s > $ws);
}
return ($win, $ws);
};
my $strong = sub { # partners with a real connection
my $n = shift;
return scalar grep { $_->[1] >= 5 } @{ $r->{partners}{$n} || [] };
};
my @roles;
my ($n, $v);
($n, $v) = $best->(sub { $r->{in}{ $_[0] } || 0 });
push @roles, [ 'role_talkedto', $n, $self->_template_text('role_talkedto_v', n => $self->_ins_num($v)) ] if $n and $v;
($n, $v) = $best->(sub { $r->{out}{ $_[0] } ? 100 * $r->{out}{ $_[0] } / (3 * $st->{lines}{ $_[0] }) : 0 });
push @roles, [ 'role_outgoing', $n, $self->_template_text('role_outgoing_v', pct => sprintf('%.0f', $v)) ] if $n and $v;
($n, $v) = $best->(sub { $strong->($_[0]) });
push @roles, [ 'role_connector', $n, $self->_template_text('role_connector_v', n => $v) ] if $n and $v;
my $connector = $n;
($n, $v) = $best->(sub { $r->{listen}{ $_[0] } || 0 });
push @roles, [ 'role_listener', $n, $self->_template_text('role_listener_v', n => $self->_ins_num($v)) ] if $n and $v;
# Lone wolf: someone with fewer close contacts than the typical regular, never the connector.
# (Lines per contact alone always picks the busiest nick, who usually knows everybody.)
my @contacts = sort { $a <=> $b } map { $strong->($_) } @pool;
my $median = $contacts[ int($#contacts / 2) ];
($n, $v) = $best->(sub {
my $c = $strong->($_[0]);
return undef if defined $connector and $_[0] eq $connector or $c >= $median;
return $st->{lines}{ $_[0] } / (1 + $c);
});
push @roles, [ 'role_lonewolf', $n, $self->_template_text('role_lonewolf_v', lines => $self->_ins_num($st->{lines}{$n}), n => $strong->($n)) ] if $n;
return unless @roles;
$self->_headline($self->_template_text('rolestopic'), 'roles');
_html('');
for my $ro (@roles) {
_html('
' . $self->_template_text($ro->[0]) . ''
. '' . $self->_ins_esc($ro->[1]) . ''
. '' . $self->_template_text($ro->[0] . '_d') . ''
. '' . $ro->[2] . '
');
}
_html('
');
}
# ---- time personalities -------------------------------------------------------------
sub _insights_personalities
{
my $self = shift;
my $st = $self->{stats};
my $min = $self->_ins_minlines;
my @pool = grep { $st->{lines}{$_} >= $min and $st->{line_times}{$_} } @{ $self->_ins_humans };
return unless @pool >= 4;
my @cols;
for my $bk (0 .. 3) {
my @rank;
for my $n (@pool) {
my $sum = 0;
$sum += $_ || 0 for @{ $st->{line_times}{$n} }[0 .. 3];
next unless $sum;
push @rank, [ $n, 100 * ($st->{line_times}{$n}[$bk] || 0) / $sum ];
}
@rank = sort { $b->[1] <=> $a->[1] or $st->{lines}{ $b->[0] } <=> $st->{lines}{ $a->[0] } or $a->[0] cmp $b->[0] } @rank;
splice(@rank, 3) if @rank > 3;
push @cols, \@rank;
}
$self->_headline($self->_template_text('persontopic'), 'personalities');
_html('');
my @names = qw(per_night per_morning per_afternoon per_evening);
for my $bk (0 .. 3) {
my ($from, $to) = ($bk * 6, $bk * 6 + 5);
_html('
' . $self->_template_text($names[$bk]) . ''
. '
' . $self->_template_text('per_range', from => $from, to => $to) . ''
. join('', map { '- ' . $self->_ins_esc($_->[0]) . ' ' . sprintf('%.0f', $_->[1]) . '%
' } @{ $cols[$bk] })
. '
');
}
_html('
');
}
# ---- concentration ------------------------------------------------------------------
sub _insights_concentration
{
my $self = shift;
my $st = $self->{stats};
my @humans = @{ $self->_ins_humans };
return unless @humans >= 3;
my $total = 0;
$total += $st->{lines}{$_} for @humans;
return unless $total;
my ($run, $half, %at) = (0, 0);
my $i = 0;
for my $n (@humans) {
$run += $st->{lines}{$n};
$i++;
$at{$i} = 100 * $run / $total;
$half ||= $i if $run * 2 >= $total;
}
my @steps = grep { $_ <= @humans } (1, 3, 5, 10, 20);
$self->_headline($self->_template_text('concentrationtopic'), 'concentration', undef, 'concentrationtopic');
_html('' . $self->_template_text('conc_half', n => $half) . '
');
_html('');
for my $s (@steps) {
_html('| ' . $self->_template_text('conc_top', n => $s) . ' | '
. '
| '
. '' . sprintf('%.1f', $at{$s}) . '% |
');
}
_html('
');
}
# ---- signature words ------------------------------------------------------------------
sub _insights_signature
{
my $self = shift;
my $st = $self->{stats};
my $sig = $st->{signature} || {};
my @nicks = grep { $sig->{$_} and !$self->_ins_isbot($_) } @{ $self->_ins_humans };
return unless @nicks;
splice(@nicks, 15) if @nicks > 15;
$self->_headline($self->_template_text('signaturetopic'), 'signature', undef, 'signaturetopic');
_html('' . $self->_template_text('sig_intro') . '
');
_html('| | '
. '' . $self->_template_text('nick') . ' | '
. '' . $self->_template_text('sig_word') . ' | '
. '' . $self->_template_text('sig_uses') . ' | '
. '' . $self->_template_text('sig_share') . ' |
');
my $i = 0;
for my $n (@nicks) {
my ($word, $uses, $share) = @{ $sig->{$n} };
$i++;
_html('| ' . $i . ' | '
. '' . $self->_ins_esc($n) . ' | '
. '' . $self->_ins_esc($word) . ' | '
. '' . $self->_ins_num($uses) . ' | '
. ' ' . $share . '% |
');
}
_html('
');
}
# ---- scripts, written once near the end of the page --------------------------------------
sub _insights_scripts
{
my $self = shift;
return unless $self->_nav_wanted or $self->{ins_script_relmap};
if ($self->{ins_script_relmap}) {
my $js = $self->_ins_slurp('relmap.js');
_html("") if length $js;
}
if ($self->_nav_wanted) {
my $js = $self->_ins_slurp('pagenav.js');
_html("") if length $js;
}
}
1;