#!/usr/bin/perl
#
# Hourly rollup of the JSONL written by fpm-sample.sh.
#
# Handles the two traps in that data:
#
#  1. "max_active", "max_children_reached", "max_listen_q" and "slow_requests"
#     are high-water marks/counters that RESET when FPM reloads. Diffing across
#     a reload gives negative throughput and hides a peak. A reload is detected
#     by "start_since" going backwards, and the boundary is reported.
#  2. "rss_peak_mb"/"rss_avg_mb" must never be multiplied by worker count to get
#     a total -- forked workers share most pages copy-on-write. "pss_total_mb"
#     is the figure that may be read as a real total.
#
# Usage:
#   ./pool-metrics-summary.pl /var/log/php8.3-fpm/metrics/pool-2026-08-14.jsonl
#   ./pool-metrics-summary.pl /var/log/php8.3-fpm/metrics/pool-*.jsonl
#
use strict;
use warnings;

sub num { my ($l, $k) = @_; return $l =~ /"\Q$k\E":(-?[\d.]+)/ ? $1 : undef }

# Delta of a monotonic counter. A decrease means the source reset -- FPM reloading
# for the pool counters, or the FPM log rotating for the error counters -- so the
# new value IS the count since the reset. Subtracting blindly gives a large
# negative number that silently cancels out a real spike in the same bucket.
sub dlt { my ($new, $old) = @_; $new //= 0; $old //= 0; return $new >= $old ? $new - $old : $new }

# --json emits the same aggregation as a machine-readable document instead of the
# table. fpm-daily-rollup uses it to persist one file per finished day, so history
# survives the 45-day deletion of the raw ticks. Deliberately the SAME code path as
# the table: the reload/reset semantics above are subtle enough that a second
# implementation would drift from this one, and a rollup that quietly disagrees with
# the summary is worse than no rollup.
my $json = 0;
@ARGV = grep { $_ eq '--json' ? do { $json = 1; 0 } : 1 } @ARGV;

# Refuse to read a terminal. Perl's <> falls back to STDIN when @ARGV is empty, so a
# mistyped or missing filename left this silently blocked on the tty -- which under
# sudo is indistinguishable from a hung script, and cost real time on 2026-08-17.
if (!@ARGV && -t STDIN) {
	print STDERR <<"USAGE";
usage: $0 [--json] <pool-YYYY-MM-DD.jsonl> [more files ...]
       zcat -f /var/log/php8.3-fpm/metrics/pool-*.jsonl* | $0 -

Reads the JSONL written by fpm-sample.sh and prints an hourly rollup per pool.
Pass "-" explicitly to read standard input.
--json emits the same figures as a JSON document (used by fpm-daily-rollup).
USAGE
	exit 2;
}

my (%h, %prev, @reloads);

while (my $line = <>) {
	next unless $line =~ /"ts":"([^"]+)".*?"pool":"(\w+)"/;
	my ($ts, $pool) = ($1, $2);
	my $hour = substr($ts, 0, 13);
	my $key  = "$pool $hour";

	if ($line =~ /"up":false/) {
		$h{$key}{down}++;
		next;
	}

	my %f = map { $_ => num($line, $_) } qw(
		accepted listen_q max_listen_q sock_recvq sock_backlog
		active idle total max_active
		max_children_reached slow_requests start_since workers
		rss_peak_mb rss_avg_mb pss_total_mb oldest_s oldest_req_s
		err_oom err_timeout warn_busy child_signal
		load1 mem_avail_mb swap_used_mb pswpout
		max_children memory_limit_mb terminate_timeout_s
	);
	# String, so num() cannot read it.
	my $pm = $line =~ /"pm":"([^"]*)"/ ? $1 : undef;

	my $r = $h{$key} ||= { n => 0 };
	$r->{n}++;
	# Read the two active-process keys carefully, because "max_$k" makes them collide by
	# sight and not by value. $r->{max_active} is the per-hour peak of the sampled
	# CURRENT active count (k = active) -- that is the honest per-hour concurrency, the
	# figure emitted as "active_max", and it is free to fall from one hour to the next.
	# $r->{max_max_active} is the per-hour maximum of FPM's OWN "max active processes",
	# which is a high-water mark since the master started: monotonic within a master's
	# life, reset only by a restart, and therefore useless for "what happened in hour X".
	# It is collected and deliberately not emitted. Swapping these two is a one-keystroke
	# edit that silently turns every occupancy number into a lifetime record.
	for my $k (qw(active listen_q max_active max_listen_q sock_recvq sock_backlog
		rss_peak_mb pss_total_mb load1 workers)) {
		next unless defined $f{$k};
		$r->{"max_$k"} = $f{$k} if !defined $r->{"max_$k"} || $f{$k} > $r->{"max_$k"};
	}
	for my $k (qw(mem_avail_mb)) {
		next unless defined $f{$k};
		$r->{"min_$k"} = $f{$k} if !defined $r->{"min_$k"} || $f{$k} < $r->{"min_$k"};
	}
	$r->{sum_active}  += $f{active}     // 0;
	$r->{sum_rss_avg} += $f{rss_avg_mb} // 0;
	$r->{oldest_s} = $f{oldest_s}
		if defined $f{oldest_s} && (!defined $r->{oldest_s} || $f{oldest_s} > $r->{oldest_s});

	# Peak age of an in-flight request over the hour -- the field that separates a pool
	# full of work from a pool full of waiting (see PORTAL-UI-PLAN.md section 6).
	#
	# NOT the same as oldest_s above, which is worker *process* age and collapses into
	# start_since because these workers are never recycled. oldest_s is still carried for
	# rollups written before oldest_req_s existed (2026-08-25); anything reasoning about
	# request latency must use oldest_req_s and treat its absence as "unknown", not zero.
	$r->{oldest_req_s} = $f{oldest_req_s}
		if defined $f{oldest_req_s}
		&& (!defined $r->{oldest_req_s} || $f{oldest_req_s} > $r->{oldest_req_s});

	# Carry the ceilings each sample was measured against, and flag an hour in which
	# they changed -- comparing occupancy across a max_children change is meaningless,
	# and on 2026-08-14 a dashboard drawing its capacity rule at a stale 40 made a
	# saturated pool look quiet.
	for my $k (qw(max_children memory_limit_mb terminate_timeout_s)) {
		next unless defined $f{$k};
		$r->{"cfg_changed"} = 1
			if defined $r->{"cfg_$k"} && $r->{"cfg_$k"} != $f{$k};
		$r->{"cfg_$k"} = $f{$k};
	}
	if (defined $pm) {
		$r->{cfg_changed} = 1 if defined $r->{cfg_pm} && $r->{cfg_pm} ne $pm;
		$r->{cfg_pm} = $pm;
	}

	my $p = $prev{$pool};
	if ($p) {
		if (defined $f{start_since} && defined $p->{start_since}
			&& $f{start_since} < $p->{start_since}) {
			push @reloads, "$ts $pool";
			$r->{reload}++;
		} else {
			$r->{d_accepted} += dlt($f{accepted},             $p->{accepted});
			$r->{d_slow}     += dlt($f{slow_requests},        $p->{slow_requests});
			$r->{d_maxkids}  += dlt($f{max_children_reached}, $p->{max_children_reached});
			$r->{d_swapout}  += dlt($f{pswpout},              $p->{pswpout});
		}
		# Sourced from the FPM log, so these reset on log rotation, not on reload,
		# and are therefore counted across a reload boundary too.
		$r->{d_oom}  += dlt($f{err_oom},      $p->{err_oom});
		$r->{d_tmo}  += dlt($f{err_timeout},  $p->{err_timeout});
		$r->{d_busy} += dlt($f{warn_busy},    $p->{warn_busy});
		$r->{d_sig}  += dlt($f{child_signal}, $p->{child_signal});
	}
	$prev{$pool} = \%f;
}

unless (%h) {
	# Same key set as a populated document -- a consumer that has to branch on which
	# keys exist will eventually forget to.
	print $json
		? "{\n  \"schema\": 1,\n  \"from\": null,\n  \"to\": null,\n  \"day\": null,\n"
			. "  \"reloads\": [],\n  \"hours\": []\n}\n"
		: "No samples found.\n";
	exit 0;
}

if ($json) {
	# Hand-rolled: this box has no JSON::PP guarantee and the payload is numbers plus
	# two \w+ strings, so a dependency would buy nothing.
	my $q = sub { my $v = shift; $v =~ s/(["\\])/\\$1/g; return "\"$v\"" };
	# Two coalescing rules, and the distinction matters to a chart:
	#   $n (gauge) -> null when absent, so a line breaks instead of diving to zero.
	#                 pss_total_mb is legitimately absent on 19 of every 20 ticks.
	#   $c (count) -> 0 when absent, because "no delta recorded" IS zero events, and
	#                 nulling it would draw a gap where the truth is "nothing happened".
	my $n = sub { defined $_[0] ? ($_[0] + 0) : 'null' };
	my $c = sub { ($_[0] // 0) + 0 };

	my @rows;
	for my $key (sort keys %h) {
		my ($pool, $hour) = split ' ', $key;
		my $r = $h{$key};
		my $reqs = $r->{d_accepted} // 0;

		# The sampler polls /fpm-status once per tick per pool, so those polls are
		# INSIDE accepted. Subtracting the sample count leaves real traffic, and
		# real_reqs ~ 0 on a pool that has routes means the pool is not receiving
		# them. That is not hypothetical: [reporting] sat unrouted from 2026-08-14
		# to 08-17 looking perfectly healthy, because "up and idle" and "up and
		# unreachable" are the same picture without this figure.
		my $real = $reqs - ($r->{n} // 0);
		$real = 0 if $real < 0;

		push @rows, join('', '{',
			'"pool":',    $q->($pool),                        ',',
			'"hour":',    $q->($hour),                        ',',
			'"samples":', $n->($r->{n}),                      ',',
			'"reqs":',    $n->($reqs),                        ',',
			'"real_reqs":', $n->($real),                      ',',
			'"active_mean":', ($r->{n} ? sprintf('%.2f', $r->{sum_active} / $r->{n}) : 'null'), ',',
			'"active_max":',  $n->($r->{max_active}),         ',',
			'"workers_max":', $n->($r->{max_workers}),        ',',
			'"sockq_max":',   $n->($r->{max_sock_recvq}),     ',',
			'"backlog":',     $n->($r->{max_sock_backlog}),   ',',
			'"rss_peak_mb":', $n->($r->{max_rss_peak_mb}),    ',',
			'"rss_avg_mb":',  ($r->{n} ? sprintf('%.1f', $r->{sum_rss_avg} / $r->{n}) : 'null'), ',',
			'"pss_total_mb":',$n->($r->{max_pss_total_mb}),   ',',
			'"pss_suspect":', ($r->{reload} ? 'true' : 'false'), ',',
			'"oldest_s":',    $n->($r->{oldest_s}),           ',',
			'"oldest_req_s":',$n->($r->{oldest_req_s}),       ',',
			'"mem_avail_min_mb":', $n->($r->{min_mem_avail_mb}), ',',
			'"load1_max":',   $n->($r->{max_load1}),          ',',
			'"swapout":',     $c->($r->{d_swapout}),          ',',
			'"slow":',        $c->($r->{d_slow}),             ',',
			'"max_children_reached":', $c->($r->{d_maxkids}), ',',
			'"oom":',         $c->($r->{d_oom}),              ',',
			'"timeout":',     $c->($r->{d_tmo}),              ',',
			'"busy":',        $c->($r->{d_busy}),             ',',
			'"signal":',      $c->($r->{d_sig}),              ',',
			'"reloads":',     $c->($r->{reload}),             ',',
			'"down":',        $c->($r->{down}),               ',',
			'"cfg_max_children":',    $n->($r->{cfg_max_children}),      ',',
			'"cfg_memory_limit_mb":', $n->($r->{cfg_memory_limit_mb}),   ',',
			'"cfg_terminate_s":',     $n->($r->{cfg_terminate_timeout_s}), ',',
			'"cfg_pm":',      (defined $r->{cfg_pm} ? $q->($r->{cfg_pm}) : 'null'), ',',
			'"cfg_changed":', ($r->{cfg_changed} ? 'true' : 'false'),
		'}');
	}

	my @hours = sort map { (split ' ', $_)[1] } keys %h;
	my %days  = map { substr($_, 0, 10) => 1 } @hours;
	my @d     = sort keys %days;

	print "{\n";
	print '  "schema": 1,', "\n";
	print '  "from": ', $q->($hours[0]), ',', "\n";
	print '  "to": ',   $q->($hours[-1]), ',', "\n";
	print '  "day": ',  (@d == 1 ? $q->($d[0]) : 'null'), ',', "\n";
	print '  "reloads": [', join(',', map { $q->($_) } @reloads), '],', "\n";
	print '  "hours": [', "\n    ", join(",\n    ", @rows), "\n  ]\n";
	print "}\n";
	exit 0;
}

printf "%-6s %-13s %5s %5s %5s %6s %6s %7s %7s %6s %6s %5s %5s %4s %4s %4s %4s\n",
	'POOL', 'HOUR', 'reqs', 'act', 'peak', 'sockq', 'bklog', 'rsspk', 'pss',
	'memav', 'swout', 'slow', 'full', 'oom', 'tmo', 'busy', 'sig';
for my $key (sort keys %h) {
	my ($pool, $hour) = split ' ', $key;
	my $r = $h{$key};
	printf "%-6s %-13s %5d %5.1f %5d %6d %6d %6.0fM %6sM %5dM %6d %5d %5d %4d %4d %4d %4d%s%s\n",
		$pool, $hour,
		$r->{d_accepted}  // 0,
		$r->{n} ? $r->{sum_active} / $r->{n} : 0,
		$r->{max_active}       // 0,
		$r->{max_sock_recvq}   // 0,
		$r->{max_sock_backlog} // 0,
		$r->{max_rss_peak_mb}  // 0,
		defined $r->{max_pss_total_mb} ? sprintf('%.0f', $r->{max_pss_total_mb}) : '-',
		$r->{min_mem_avail_mb} // 0,
		$r->{d_swapout}        // 0,
		$r->{d_slow}           // 0,
		$r->{d_maxkids}        // 0,
		$r->{d_oom}            // 0,
		$r->{d_tmo}            // 0,
		$r->{d_busy}           // 0,
		$r->{d_sig}            // 0,
		($r->{reload} ? '  RELOAD' : ''),
		($r->{down}   ? "  DOWN x$r->{down}" : '');
}

print "\nact   = mean busy workers      peak  = highest busy workers seen\n";
print "sockq = highest queued-but-unaccepted connection count seen (ss Recv-Q)\n";
print "bklog = configured listen.backlog as the kernel sees it (ss Send-Q)\n";
print "        These replace FPM's own listen_q/max_listen_q, which are ALWAYS 0 here:\n";
print "        FPM can only read accept-queue depth on a TCP socket, and every pool on\n";
print "        this host listens on a UNIX socket. sockq is sampled per tick with no\n";
print "        high-water mark behind it, so a spike shorter than the interval can be\n";
print "        missed -- but a non-zero value is proof of queueing, and 'peak == its\n";
print "        max_children' plus sockq > 0 is what saturation actually looks like.\n";
print "rsspk = largest single worker  pss   = true pool total (safe to read as a total)\n";
print "        ^^ EXCEPT on a RELOAD hour: both worker generations are alive during a\n";
print "        graceful reload and both are counted, so pss is roughly doubled there.\n";
print "        Sanity check: pss can never exceed workers x rsspk.\n";
print "swout = pages swapped OUT      full  = times max_children was hit\n";
print "oom   = memory_limit fatals    tmo   = max_execution_time fatals\n";
print "busy  = FPM 'seems busy' or 'reached max_children' warnings\n";
print "sig   = workers killed by a signal (segfault / OOM killer)\n";
print "\nWhich setting each column argues about:\n";
print "  peak/full -> pm.max_children      rsspk/pss  -> pm.max_requests, memory_limit\n";
print "  oom       -> memory_limit         tmo        -> max_execution_time\n";
print "  busy      -> pm.start_servers, pm.min/max_spare_servers (www pool only)\n";
print "  sockq     -> pm.max_children first, listen.backlog second\n";
print "  slow      -> request_slowlog_timeout\n";

if (@reloads) {
	print "\nFPM reloads (counters reset here -- do not diff across these):\n";
	print "  $_\n" for @reloads;
}