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('' . '' . '' . ''); 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('' . '' . '' . ''); } _html('
 ' . $self->_template_text('pair') . '' . $self->_template_text('rel_strength') . '' . $self->_template_text('pair_detail') . '
' . $i . '' . $self->_ins_esc($p->{a}) . ' ↔ ' . $self->_ins_esc($p->{b}) . '
' . $self->_ins_num($p->{w}) . '
' . $detail . '
'); } 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; ($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; ($n, $v) = $best->(sub { $st->{lines}{ $_[0] } / (1 + $strong->($_[0])) }); 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 { '
  1. ' . $self->_ins_esc($_->[0]) . ' ' . sprintf('%.0f', $_->[1]) . '%
  2. ' } @{ $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('' . '' . ''); } _html('
' . $self->_template_text('conc_top', n => $s) . '
' . sprintf('%.1f', $at{$s}) . '%
'); } # ---- 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('' . '' . '' . '' . ''); my $i = 0; for my $n (@nicks) { my ($word, $uses, $share) = @{ $sig->{$n} }; $i++; _html('' . '' . '' . '' . ''); } _html('
 ' . $self->_template_text('nick') . '' . $self->_template_text('sig_word') . '' . $self->_template_text('sig_uses') . '' . $self->_template_text('sig_share') . '
' . $i . '' . $self->_ins_esc($n) . '' . $self->_ins_esc($word) . '' . $self->_ins_num($uses) . '
' . $share . '%
'); } # ---- 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;