#!/usr/bin/env perl
# ./analyze_tbeam_bilateral_transfer_20260520_0412.pl BLE_CY_DAN_20260519_2051.zip
# ./analyze_tbeam_bilateral_transfer_20260520_0412.pl --detail BLE_CY_DAN_20260519_2051.zip
# ./analyze_tbeam_bilateral_transfer_20260520_0412.pl --csv tbeam_chunks_$(date +%Y%m%d_%H%M).csv BLE_CY_DAN_20260519_2051.zip
# ./analyze_tbeam_bilateral_transfer_20260520_0412.pl --report tbeam_report_$(date +%Y%m%d_%H%M).txt BLE_CY_DAN_20260519_2051.zip
#
# 20260520 ChatGPT
# $Header$
# $HeadURL$
#
=pod

Purpose:
  Analyze two or more ESP32/T-Beam serial monitor logs from a bilateral
  microReticulum + Reticulum BLE file transfer.

  The script is intentionally parallel in spirit to
  analyze_reticulum_file_transfer_20260518_1930.pl, but the T-Beam logs have a
  different shape:

    [1779249101.7991] TX FILE BEGIN: round=3 file=US_Constitution.txt ...
    [1779249101.9005] TX FILE DATA: round=3 seq=1/148 bytes=300 ...
    [1779249105.8511] RX FILE END: from=Node-... received=0/44225 chunks=0/148 ... status=VERIFY_FAIL
    [1779249090.6498] 00:21:47.653 [ERR] Decryption failed ... Token token HMAC was invalid

  It accepts either log files directly or a .zip archive containing log files.
  Zip extraction uses the system unzip command because that is usually already
  present on Gentoo/Debian systems and avoids a non-core Perl dependency.

Interpretation note:
  HMAC failures mean the receiver rejected encrypted Reticulum traffic before it
  became valid application payload. Therefore, a transfer can show many Reticulum
  decrypt errors while showing zero RX FILE DATA records.

=cut

use strict;
use warnings;
use Getopt::Long qw(GetOptions);
use POSIX qw(strftime);
use List::Util qw(min max sum);
use File::Basename qw(basename dirname);
use File::Temp qw(tempdir);
use Cwd qw(abs_path getcwd);

my $detail      = 0;
my $csv_file    = '';
my $report_file = '';
my $keep_extract = 0;

GetOptions(
    'detail!'      => \$detail,
    'csv=s'        => \$csv_file,
    'report=s'     => \$report_file,
    'keep-extract' => \$keep_extract,
    'help'         => \my $help,
) or die usage();

if ($help || !@ARGV) {
    print usage();
    exit($help ? 0 : 1);
}

my @input_files = expand_inputs(@ARGV);
@input_files or die "No readable log files found.\n";

my @reports;
for my $file (@input_files) {
    push @reports, parse_tbeam_log($file);
}

my %node_to_board = infer_node_to_board(@reports);
annotate_remote_boards(\@reports, \%node_to_board);
annotate_errors(\@reports);

my $text = build_report(\@reports, \%node_to_board, $detail);

if ($report_file ne '') {
    open my $rfh, '>', $report_file or die "Cannot write $report_file: $!\n";
    print {$rfh} $text;
    close $rfh;
    print "Report written: $report_file\n";
}
else {
    print $text;
}

write_csv($csv_file, \@reports) if $csv_file ne '';

exit 0;

sub expand_inputs {
    my (@args) = @_;
    my @files;

    for my $arg (@args) {
        if (-d $arg) {
            push @files, grep { -f $_ && -r $_ } glob("$arg/*");
            next;
        }
        if ($arg =~ /\.zip\z/i) {
            push @files, extract_zip_logs($arg);
            next;
        }
        push @files, $arg if -f $arg && -r $arg;
    }

    @files = grep { /(?:\.log|\.txt)\z/i || file_looks_like_tbeam_log($_) } @files;
    return sort @files;
}

sub extract_zip_logs {
    my ($zip) = @_;
    -r $zip or die "Cannot read zip archive $zip\n";

    my $tdir = tempdir('tbeam_ble_logs_XXXXXX', TMPDIR => 1, CLEANUP => !$keep_extract);
    my $cmd = sprintf('unzip -q %s -d %s', shellq($zip), shellq($tdir));
    system($cmd) == 0 or die "unzip failed for $zip\n";

    my @found;
    open my $find, '-|', 'find', $tdir, '-type', 'f' or die "Cannot run find: $!\n";
    while (my $path = <$find>) {
        chomp $path;
        push @found, $path if $path =~ /(?:\.log|\.txt)\z/i || file_looks_like_tbeam_log($path);
    }
    close $find;

    warn "Extracted zip under $tdir\n" if $keep_extract;
    return @found;
}

sub file_looks_like_tbeam_log {
    my ($file) = @_;
    open my $fh, '<', $file or return 0;
    my $n = 0;
    while (my $line = <$fh>) {
        ++$n;
        if ($line =~ /^#\s+Board:/ || $line =~ /^\[\d+\.\d+\]\s+(?:TX|RX) FILE / || $line =~ /Decryption failed on link/) {
            close $fh;
            return 1;
        }
        last if $n > 40;
    }
    close $fh;
    return 0;
}

sub parse_tbeam_log {
    my ($file) = @_;

    open my $fh, '<', $file or die "Cannot open $file: $!\n";

    my %r = (
        file        => $file,
        base        => basename($file),
        header      => {},
        tx_rounds   => {},
        rx_sessions => [],
        errors      => [],
        events      => [],
        line_count  => 0,
    );

    my %active_rx_by_node;

    while (my $line = <$fh>) {
        ++$r{line_count};
        chomp $line;

        if ($line =~ /^#\s*([^:]+):\s*(.*)$/) {
            my ($k, $v) = (trim($1), trim($2));
            $r{header}{$k} = $v;
            next;
        }

        next unless $line =~ /^\[([0-9]+(?:\.[0-9]+)?)\]\s+(.*)$/;
        my ($epoch, $msg) = ($1 + 0.0, $2);

        $r{first_epoch} = $epoch if !defined $r{first_epoch};
        $r{last_epoch} = $epoch;

        if ($msg =~ /^TX FILE BEGIN:\s+round=(\d+)\s+file=(\S+)\s+bytes=(\d+)\s+chunks=(\d+)\s+crc=([0-9A-Fa-f]+)/) {
            my ($round, $file_name, $bytes, $chunks, $crc) = ($1+0, $2, $3+0, $4+0, uc($5));
            my $tx = ($r{tx_rounds}{$round} ||= new_tx_round($round));
            @{$tx}{qw(begin_epoch file bytes_expected chunks_expected crc_expected)} = ($epoch, $file_name, $bytes, $chunks, $crc);
            push @{$r{events}}, { type => 'tx_begin', epoch => $epoch, round => $round, line => $r{line_count} };
            next;
        }

        if ($msg =~ /^TX FILE DATA:\s+round=(\d+)\s+seq=(\d+)\/(\d+)\s+bytes=(\d+)/) {
            my ($round, $seq, $total, $bytes) = ($1+0, $2+0, $3+0, $4+0);
            my $tx = ($r{tx_rounds}{$round} ||= new_tx_round($round));
            push @{$tx->{data}}, { epoch => $epoch, seq => $seq, total => $total, bytes => $bytes, line => $r{line_count} };
            $tx->{chunks_expected} ||= $total;
            push @{$r{events}}, { type => 'tx_data', epoch => $epoch, round => $round, seq => $seq, line => $r{line_count} };
            next;
        }

        if ($msg =~ /^TX FILE END:\s+round=(\d+)\s+file=(\S+)\s+bytes=(\d+)\s+chunks=(\d+)\s+crc=([0-9A-Fa-f]+)(?:\s+next_round_in_ms=(\d+))?/) {
            my ($round, $file_name, $bytes, $chunks, $crc, $next_ms) = ($1+0, $2, $3+0, $4+0, uc($5), $6);
            my $tx = ($r{tx_rounds}{$round} ||= new_tx_round($round));
            @{$tx}{qw(end_epoch file bytes_expected chunks_expected crc_expected)} = ($epoch, $file_name, $bytes, $chunks, $crc);
            $tx->{next_round_in_ms} = $next_ms + 0 if defined $next_ms;
            push @{$r{events}}, { type => 'tx_end', epoch => $epoch, round => $round, line => $r{line_count} };
            next;
        }

        if ($msg =~ /^RX FILE BEGIN:\s+from=(\S+)\s+file=(\S+)\s+bytes=(\d+)\s+chunks=(\d+)\s+crc=([0-9A-Fa-f]+)/) {
            my ($from, $file_name, $bytes, $chunks, $crc) = ($1, $2, $3+0, $4+0, uc($5));
            my $sess = {
                idx             => scalar(@{$r{rx_sessions}}) + 1,
                from_node       => $from,
                file            => $file_name,
                begin_epoch     => $epoch,
                bytes_expected  => $bytes,
                chunks_expected => $chunks,
                crc_expected    => $crc,
                data            => [],
                errors          => [],
                begin_line      => $r{line_count},
            };
            push @{$r{rx_sessions}}, $sess;
            $active_rx_by_node{$from} = $sess;
            push @{$r{events}}, { type => 'rx_begin', epoch => $epoch, rx_idx => $sess->{idx}, from_node => $from, line => $r{line_count} };
            next;
        }

        if ($msg =~ /^RX FILE DATA:\s+from=(\S+)\s+seq=(\d+)\/(\d+)\s+bytes=(\d+)/) {
            my ($from, $seq, $total, $bytes) = ($1, $2+0, $3+0, $4+0);
            my $sess = $active_rx_by_node{$from};
            if (!$sess) {
                $sess = {
                    idx             => scalar(@{$r{rx_sessions}}) + 1,
                    from_node       => $from,
                    file            => 'UNKNOWN',
                    begin_epoch     => undef,
                    bytes_expected  => undef,
                    chunks_expected => $total,
                    crc_expected    => undef,
                    data            => [],
                    errors          => [],
                    synthetic       => 1,
                };
                push @{$r{rx_sessions}}, $sess;
                $active_rx_by_node{$from} = $sess;
            }
            push @{$sess->{data}}, { epoch => $epoch, seq => $seq, total => $total, bytes => $bytes, line => $r{line_count} };
            $sess->{chunks_expected} ||= $total;
            push @{$r{events}}, { type => 'rx_data', epoch => $epoch, rx_idx => $sess->{idx}, from_node => $from, seq => $seq, line => $r{line_count} };
            next;
        }

        if ($msg =~ /^RX FILE END:\s+from=(\S+)\s+file=(\S+)\s+received=(\d+)\/(\d+)\s+chunks=(\d+)\/(\d+)\s+crc=([0-9A-Fa-f]+)\s+status=(\S+)/) {
            my ($from, $file_name, $rx_bytes, $expect_bytes, $rx_chunks, $expect_chunks, $crc, $status) = ($1, $2, $3+0, $4+0, $5+0, $6+0, uc($7), $8);
            my $sess = $active_rx_by_node{$from};
            if (!$sess) {
                $sess = {
                    idx             => scalar(@{$r{rx_sessions}}) + 1,
                    from_node       => $from,
                    file            => $file_name,
                    begin_epoch     => undef,
                    bytes_expected  => $expect_bytes,
                    chunks_expected => $expect_chunks,
                    crc_expected    => undef,
                    data            => [],
                    errors          => [],
                    synthetic       => 1,
                };
                push @{$r{rx_sessions}}, $sess;
            }
            @{$sess}{qw(end_epoch file bytes_received bytes_expected chunks_received chunks_expected crc_seen status end_line)} =
                ($epoch, $file_name, $rx_bytes, $expect_bytes, $rx_chunks, $expect_chunks, $crc, $status, $r{line_count});
            delete $active_rx_by_node{$from};
            push @{$r{events}}, { type => 'rx_end', epoch => $epoch, rx_idx => $sess->{idx}, from_node => $from, line => $r{line_count} };
            next;
        }

        if ($msg =~ /\[ERR\]\s+Decryption failed on link\s+\{Link:([^}]+)\}\.\s+The contained exception was:\s+(.+)$/) {
            my ($link, $exception) = ($1, $2);
            my $class = classify_error($exception);
            my $err = {
                epoch     => $epoch,
                link      => $link,
                exception => $exception,
                class     => $class,
                line      => $r{line_count},
                raw       => $msg,
            };
            push @{$r{errors}}, $err;
            push @{$r{events}}, { type => 'error', epoch => $epoch, error => $err, line => $r{line_count} };
            next;
        }
    }
    close $fh;

    $r{board} = $r{header}{Board} || board_from_filename($file);
    summarize_tx_round($_) for values %{$r{tx_rounds}};
    summarize_rx_session($_) for @{$r{rx_sessions}};
    return \%r;
}

sub new_tx_round {
    my ($round) = @_;
    return {
        round => $round,
        data  => [],
    };
}

sub classify_error {
    my ($e) = @_;
    return 'HMAC_INVALID' if $e =~ /HMAC/i;
    return 'PADDING_INVALID' if $e =~ /pad|padding/i;
    return 'TOKEN_INVALID' if $e =~ /token/i;
    return 'OTHER';
}

sub summarize_tx_round {
    my ($tx) = @_;
    my @d = sort { $a->{seq} <=> $b->{seq} || $a->{epoch} <=> $b->{epoch} } @{$tx->{data}};
    $tx->{data} = \@d;
    $tx->{data_count} = scalar @d;
    $tx->{bytes_sent_logged} = sum0(map { $_->{bytes} } @d);
    $tx->{first_data_epoch} = @d ? $d[0]{epoch} : undef;
    $tx->{last_data_epoch}  = @d ? $d[-1]{epoch} : undef;
    $tx->{first_seq} = @d ? min(map { $_->{seq} } @d) : undef;
    $tx->{last_seq}  = @d ? max(map { $_->{seq} } @d) : undef;
    $tx->{chunk_total_seen} = @d ? max(map { $_->{total} } @d) : ($tx->{chunks_expected} || 0);
    $tx->{missing} = missing_ranges([ map { $_->{seq} } @d ], $tx->{chunk_total_seen});
    $tx->{duplicates} = duplicate_list(map { $_->{seq} } @d);
    $tx->{data_span} = defined($tx->{first_data_epoch}) && defined($tx->{last_data_epoch}) ? $tx->{last_data_epoch} - $tx->{first_data_epoch} : undef;
    $tx->{round_span} = defined($tx->{begin_epoch}) && defined($tx->{end_epoch}) ? $tx->{end_epoch} - $tx->{begin_epoch} : undef;
    $tx->{gaps} = [ consecutive_deltas(map { $_->{epoch} } @d) ];
}

sub summarize_rx_session {
    my ($s) = @_;
    my @d = sort { $a->{seq} <=> $b->{seq} || $a->{epoch} <=> $b->{epoch} } @{$s->{data}};
    $s->{data} = \@d;
    $s->{data_count} = scalar @d;
    $s->{bytes_data_logged} = sum0(map { $_->{bytes} } @d);
    $s->{first_data_epoch} = @d ? $d[0]{epoch} : undef;
    $s->{last_data_epoch}  = @d ? $d[-1]{epoch} : undef;
    $s->{first_seq} = @d ? min(map { $_->{seq} } @d) : undef;
    $s->{last_seq}  = @d ? max(map { $_->{seq} } @d) : undef;
    $s->{missing} = missing_ranges([ map { $_->{seq} } @d ], $s->{chunks_expected} || 0);
    $s->{duplicates} = duplicate_list(map { $_->{seq} } @d);
    $s->{data_span} = defined($s->{first_data_epoch}) && defined($s->{last_data_epoch}) ? $s->{last_data_epoch} - $s->{first_data_epoch} : undef;
    $s->{session_span} = defined($s->{begin_epoch}) && defined($s->{end_epoch}) ? $s->{end_epoch} - $s->{begin_epoch} : undef;
    $s->{gaps} = [ consecutive_deltas(map { $_->{epoch} } @d) ];
}

sub infer_node_to_board {
    my (@reports) = @_;
    my %received_from;
    for my $r (@reports) {
        my $board = $r->{board};
        for my $s (@{$r->{rx_sessions}}) {
            next unless defined $s->{from_node};
            $received_from{$board}{$s->{from_node}}++;
        }
    }

    my %node_to_board;
    if (@reports == 2) {
        my ($a, $b) = @reports;
        my ($board_a, $board_b) = ($a->{board}, $b->{board});
        for my $node (keys %{$received_from{$board_a} || {}}) {
            $node_to_board{$node} = $board_b;
        }
        for my $node (keys %{$received_from{$board_b} || {}}) {
            $node_to_board{$node} = $board_a;
        }
    }
    return %node_to_board;
}

sub annotate_remote_boards {
    my ($reports, $node_to_board) = @_;
    for my $r (@$reports) {
        for my $s (@{$r->{rx_sessions}}) {
            $s->{from_board} = $node_to_board->{$s->{from_node}} if defined $s->{from_node} && exists $node_to_board->{$s->{from_node}};
        }
    }
}

sub annotate_errors {
    my ($reports) = @_;
    for my $r (@$reports) {
        my @tx = values %{$r->{tx_rounds}};
        my @rx = @{$r->{rx_sessions}};
        for my $e (@{$r->{errors}}) {
            for my $tx (@tx) {
                next unless defined $tx->{begin_epoch} && defined $tx->{end_epoch};
                if ($e->{epoch} >= $tx->{begin_epoch} && $e->{epoch} <= $tx->{end_epoch}) {
                    $e->{tx_round} = $tx->{round};
                    $tx->{error_count}++;
                }
            }
            for my $s (@rx) {
                next unless defined $s->{begin_epoch} && defined $s->{end_epoch};
                if ($e->{epoch} >= $s->{begin_epoch} && $e->{epoch} <= $s->{end_epoch}) {
                    $e->{rx_idx} = $s->{idx};
                    push @{$s->{errors}}, $e;
                }
            }
        }
    }
}

sub build_report {
    my ($reports, $node_to_board, $detail) = @_;
    my $out = '';
    my $emit = sub { $out .= join('', @_) };

    $emit->("Reticulum BLE T-Beam bilateral transfer analysis\n");
    $emit->("Generated: ", strftime('%Y-%m-%d %H:%M:%S %Z', localtime), "\n");
    $emit->("Input files:\n");
    for my $r (@$reports) {
        $emit->("  $r->{file}\n");
    }
    $emit->("\n");

    $emit->("Capture summary:\n");
    for my $r (@$reports) {
        my $duration = defined($r->{first_epoch}) && defined($r->{last_epoch}) ? $r->{last_epoch} - $r->{first_epoch} : 0;
        $emit->(sprintf "  %-36s board=%-6s port=%-12s exercise=%-6s lines=%6d duration=%8.3f s\n",
            $r->{base}, $r->{board} || 'UNKNOWN', $r->{header}{Port} || 'UNKNOWN', $r->{header}{Exercise} || 'n/a', $r->{line_count}, $duration);
        $emit->(sprintf "    started : %s\n", $r->{header}{Started} || 'not seen');
        $emit->(sprintf "    command : %s\n", $r->{header}{Command} || 'not seen');
    }
    $emit->("\n");

    $emit->("Inferred Reticulum node identity map:\n");
    if (%$node_to_board) {
        for my $node (sort keys %$node_to_board) {
            $emit->(sprintf "  %-22s => %s\n", $node, $node_to_board->{$node});
        }
    }
    else {
        $emit->("  not enough information to infer node-to-board mapping\n");
    }
    $emit->("\n");

    $emit->("Per-board high-level totals:\n");
    for my $r (@$reports) {
        my @tx_rounds = values %{$r->{tx_rounds}};
        my @rx_sessions = @{$r->{rx_sessions}};
        my $tx_data = sum0(map { $_->{data_count} } @tx_rounds);
        my $rx_data = sum0(map { $_->{data_count} } @rx_sessions);
        my $rx_ok = scalar grep { ($_->{status} || '') eq 'OK' } @rx_sessions;
        my $rx_fail = scalar grep { ($_->{status} || '') ne '' && ($_->{status} || '') ne 'OK' } @rx_sessions;
        my %err_class;
        $err_class{$_->{class}}++ for @{$r->{errors}};
        $emit->(sprintf "  %-6s tx_rounds=%3d tx_data=%4d rx_sessions=%3d rx_data=%4d rx_ok=%3d rx_fail=%3d decrypt_errors=%5d",
            $r->{board}, scalar(@tx_rounds), $tx_data, scalar(@rx_sessions), $rx_data, $rx_ok, $rx_fail, scalar(@{$r->{errors}}));
        if (%err_class) {
            $emit->("  ", join(' ', map { "$err_class{$_} $_" } sort keys %err_class));
        }
        $emit->("\n");
    }
    $emit->("\n");

    $emit->("TX round summary:\n");
    for my $r (@$reports) {
        $emit->("  Board $r->{board}\n");
        for my $round (sort { $a <=> $b } keys %{$r->{tx_rounds}}) {
            my $tx = $r->{tx_rounds}{$round};
            my $expected = $tx->{chunks_expected} || $tx->{chunk_total_seen} || 0;
            my $complete = $expected ? 100.0 * $tx->{data_count} / $expected : 0;
            $emit->(sprintf "    round=%-3d file=%-22s chunks=%3d/%-3d completeness=%6.2f%% bytes_logged=%6d span=%8s data_span=%8s errors_during_tx=%4d missing=%s dupes=%s\n",
                $round,
                $tx->{file} || 'UNKNOWN',
                $tx->{data_count} || 0,
                $expected,
                $complete,
                $tx->{bytes_sent_logged} || 0,
                fmt_s($tx->{round_span}),
                fmt_s($tx->{data_span}),
                $tx->{error_count} || 0,
                @{$tx->{missing}} ? join(',', @{$tx->{missing}}) : 'none',
                @{$tx->{duplicates}} ? join(',', @{$tx->{duplicates}}) : 'none');
            emit_gap_stats_to_string(\$out, "      tx inter-data gap", $tx->{gaps});
        }
    }
    $emit->("\n");

    $emit->("RX session summary:\n");
    for my $r (@$reports) {
        $emit->("  Board $r->{board}\n");
        for my $s (sort { ($a->{begin_epoch} || 0) <=> ($b->{begin_epoch} || 0) } @{$r->{rx_sessions}}) {
            my $expected = $s->{chunks_expected} || 0;
            my $rx_chunks = defined($s->{chunks_received}) ? $s->{chunks_received} : $s->{data_count};
            my $complete = $expected ? 100.0 * $rx_chunks / $expected : 0;
            $emit->(sprintf "    rx#=%-2d from=%-6s node=%-22s file=%-22s status=%-11s chunks=%3d/%-3d completeness=%6.2f%% bytes=%6s/%-6s crc=%-8s expect=%-8s session_span=%8s data_span=%8s errors=%4d missing=%s dupes=%s\n",
                $s->{idx},
                $s->{from_board} || '?',
                $s->{from_node} || 'UNKNOWN',
                $s->{file} || 'UNKNOWN',
                $s->{status} || 'OPEN/UNKNOWN',
                $rx_chunks,
                $expected,
                $complete,
                defined($s->{bytes_received}) ? $s->{bytes_received} : $s->{bytes_data_logged} || 0,
                defined($s->{bytes_expected}) ? $s->{bytes_expected} : '?',
                $s->{crc_seen} || '?',
                $s->{crc_expected} || '?',
                fmt_s($s->{session_span}),
                fmt_s($s->{data_span}),
                scalar(@{$s->{errors} || []}),
                @{$s->{missing}} ? join(',', @{$s->{missing}}) : 'none',
                @{$s->{duplicates}} ? join(',', @{$s->{duplicates}}) : 'none');
            emit_gap_stats_to_string(\$out, "      rx inter-data gap", $s->{gaps});
        }
    }
    $emit->("\n");

    $emit->("Decrypt error summary:\n");
    for my $r (@$reports) {
        my @e = @{$r->{errors}};
        $emit->("  Board $r->{board}\n");
        if (!@e) {
            $emit->("    none\n");
            next;
        }
        my %by_class; $by_class{$_->{class}}++ for @e;
        my %by_link;  $by_link{$_->{link}}++ for @e;
        my $span = $e[-1]{epoch} - $e[0]{epoch};
        my $rate = $span > 0 ? @e / $span : 0;
        $emit->(sprintf "    total=%d first=%s last=%s span=%.3f s rate=%.2f errors/s\n",
            scalar(@e), fmt_epoch($e[0]{epoch}), fmt_epoch($e[-1]{epoch}), $span, $rate);
        $emit->("    by class: ", join(', ', map { "$by_class{$_} $_" } sort keys %by_class), "\n");
        $emit->("    by link : ", join(', ', map { "$by_link{$_} $_" } sort keys %by_link), "\n");

        my %by_tx;
        my %by_rx;
        for my $err (@e) {
            $by_tx{defined($err->{tx_round}) ? $err->{tx_round} : 'no-active-tx'}++;
            $by_rx{defined($err->{rx_idx}) ? $err->{rx_idx} : 'no-active-rx'}++;
        }
        $emit->("    during TX rounds: ", join(', ', map { "$_=$by_tx{$_}" } sort by_mixed keys %by_tx), "\n");
        $emit->("    during RX sessions: ", join(', ', map { "$_=$by_rx{$_}" } sort by_mixed keys %by_rx), "\n");
        emit_error_bursts(\$out, \@e);
    }
    $emit->("\n");

    $emit->("Bilateral asymmetry notes:\n");
    $emit->(build_asymmetry_notes($reports));
    $emit->("\n");

    if ($detail) {
        $emit->("Detailed RX DATA rows:\n");
        for my $r (@$reports) {
            $emit->("  Board $r->{board}\n");
            for my $s (@{$r->{rx_sessions}}) {
                for my $d (@{$s->{data}}) {
                    $emit->(sprintf "    rx#=%-2d t=%s from=%-6s seq=%3d/%-3d bytes=%3d line=%d\n",
                        $s->{idx}, fmt_epoch($d->{epoch}), $s->{from_board} || '?', $d->{seq}, $d->{total}, $d->{bytes}, $d->{line});
                }
            }
        }
        $emit->("\n");
    }

    $emit->("Caution:\n");
    $emit->("  This report uses the host-side epoch prefix from the serial monitor. That is excellent for ordering and gap analysis,\n");
    $emit->("  but it is not the same as an on-device timestamp captured before BLE queueing and Reticulum decrypt work.\n");

    return $out;
}

sub build_asymmetry_notes {
    my ($reports) = @_;
    my $s = '';
    for my $r (@$reports) {
        my $board = $r->{board};
        my $err_count = scalar @{$r->{errors}};
        my $rx_ok = scalar grep { ($_->{status} || '') eq 'OK' } @{$r->{rx_sessions}};
        my $rx_fail = scalar grep { ($_->{status} || '') ne '' && ($_->{status} || '') ne 'OK' } @{$r->{rx_sessions}};
        my $zero_chunk_fail = scalar grep { (($_->{status} || '') ne '' && ($_->{status} || '') ne 'OK') && (($_->{chunks_received} || 0) == 0) } @{$r->{rx_sessions}};
        $s .= sprintf("  %-6s rx_ok=%d rx_fail=%d zero_chunk_fail=%d decrypt_errors=%d\n", $board, $rx_ok, $rx_fail, $zero_chunk_fail, $err_count);
    }

    my @bad = grep { @{$_->{errors}} > 0 } @$reports;
    my @good = grep { @{$_->{errors}} == 0 } @$reports;
    if (@bad && @good) {
        $s .= "  Observation: decrypt failures are asymmetric. At least one board receives complete files while another reports Reticulum HMAC failures.\n";
        $s .= "  Working hypothesis: investigate the receiver/server side before blaming the Constitution payload or the sender text chunker.\n";
    }
    return $s;
}


sub emit_error_bursts {
    my ($out_ref, $errors) = @_;
    my %bin;
    for my $e (@$errors) {
        $bin{int($e->{epoch})}++;
    }
    my @top = sort { $bin{$b} <=> $bin{$a} || $a <=> $b } keys %bin;
    @top = @top[0 .. min(4, $#top)] if @top > 5;
    $$out_ref .= "    busiest seconds: ";
    $$out_ref .= @top ? join(', ', map { fmt_epoch($_) . "=$bin{$_}" } @top) : 'none';
    $$out_ref .= "\n";
}

sub write_csv {
    my ($csv, $reports) = @_;
    open my $out, '>', $csv or die "Cannot write $csv: $!\n";
    print {$out} join(',', qw(board event direction peer file round rx_idx seq total bytes epoch time status crc expected_crc error_class link line source_log)), "\n";
    for my $r (@$reports) {
        for my $round (sort { $a <=> $b } keys %{$r->{tx_rounds}}) {
            my $tx = $r->{tx_rounds}{$round};
            for my $d (@{$tx->{data}}) {
                print {$out} join(',', map { csvq($_) } (
                    $r->{board}, 'TX_FILE_DATA', 'tx', '', $tx->{file} || '', $round, '',
                    $d->{seq}, $d->{total}, $d->{bytes}, sprintf('%.4f', $d->{epoch}), fmt_epoch($d->{epoch}), '', '', '', '', '', $d->{line}, $r->{base}
                )), "\n";
            }
        }
        for my $s (@{$r->{rx_sessions}}) {
            for my $d (@{$s->{data}}) {
                print {$out} join(',', map { csvq($_) } (
                    $r->{board}, 'RX_FILE_DATA', 'rx', $s->{from_board} || $s->{from_node} || '', $s->{file} || '', '', $s->{idx},
                    $d->{seq}, $d->{total}, $d->{bytes}, sprintf('%.4f', $d->{epoch}), fmt_epoch($d->{epoch}), $s->{status} || '', $s->{crc_seen} || '', $s->{crc_expected} || '', '', '', $d->{line}, $r->{base}
                )), "\n";
            }
        }
        for my $e (@{$r->{errors}}) {
            print {$out} join(',', map { csvq($_) } (
                $r->{board}, 'DECRYPT_ERROR', 'rx', '', '', $e->{tx_round} || '', $e->{rx_idx} || '',
                '', '', '', sprintf('%.4f', $e->{epoch}), fmt_epoch($e->{epoch}), '', '', '', $e->{class}, $e->{link}, $e->{line}, $r->{base}
            )), "\n";
        }
    }
    close $out;
    print "CSV written: $csv\n";
}

# Build-report-local gap appender. Kept separate from emit_gap_stats to avoid passing closures everywhere.
sub emit_gap_stats_to_string {
    my ($out_ref, $label, $values) = @_;
    return if !$values || !@$values;
    $$out_ref .= sprintf "%s min/median/mean/p95/max/stddev: %.3f / %.3f / %.3f / %.3f / %.3f / %.3f ms\n",
        $label,
        min(@$values) * 1000.0,
        percentile(50, @$values) * 1000.0,
        mean(@$values) * 1000.0,
        percentile(95, @$values) * 1000.0,
        max(@$values) * 1000.0,
        stddev(@$values) * 1000.0;
}

# Monkey-patch wrapper used by build_report's lexical $out. This is clearer than a global in usage.
# Perl has no closures by name, so build_report calls this helper via explicit code below.

sub fmt_s {
    my ($v) = @_;
    return 'n/a' unless defined $v;
    return sprintf('%.3f s', $v);
}

sub fmt_epoch {
    my ($epoch) = @_;
    return 'n/a' unless defined $epoch;
    my $whole = int($epoch);
    my $ms = int(($epoch - $whole) * 1000.0 + 0.5);
    if ($ms >= 1000) { ++$whole; $ms -= 1000; }
    return strftime('%H:%M:%S', localtime($whole)) . sprintf('.%03d', $ms);
}

sub consecutive_deltas {
    my (@v) = @_;
    my @d;
    for (my $i = 1; $i < @v; ++$i) {
        push @d, $v[$i] - $v[$i - 1];
    }
    return @d;
}

sub missing_ranges {
    my ($seen_ref, $expected) = @_;
    return [] if !$expected;
    my %seen = map { $_ => 1 } @$seen_ref;
    my @missing = grep { !$seen{$_} } 1 .. $expected;
    return [] unless @missing;

    my @ranges;
    my ($start, $prev) = ($missing[0], $missing[0]);
    for my $m (@missing[1 .. $#missing]) {
        if ($m == $prev + 1) {
            $prev = $m;
        }
        else {
            push @ranges, $start == $prev ? $start : "$start-$prev";
            ($start, $prev) = ($m, $m);
        }
    }
    push @ranges, $start == $prev ? $start : "$start-$prev";
    return \@ranges;
}

sub duplicate_list {
    my (@v) = @_;
    my %count;
    ++$count{$_} for @v;
    return [ sort { $a <=> $b } grep { $count{$_} > 1 } keys %count ];
}

sub percentile {
    my ($p, @values) = @_;
    @values = sort { $a <=> $b } @values;
    return 0 unless @values;
    return $values[0] if @values == 1;
    my $rank = ($p / 100.0) * (@values - 1);
    my $lo = int($rank);
    my $hi = $lo + 1;
    return $values[$lo] if $hi > $#values;
    my $frac = $rank - $lo;
    return $values[$lo] + (($values[$hi] - $values[$lo]) * $frac);
}

sub mean {
    my (@values) = @_;
    return 0 unless @values;
    return sum0(@values) / @values;
}

sub stddev {
    my (@values) = @_;
    return 0 if @values < 2;
    my $mean = mean(@values);
    my $ss = 0;
    $ss += ($_ - $mean) ** 2 for @values;
    return sqrt($ss / @values);
}

sub sum0 {
    return 0 unless @_;
    my $s = sum(@_);
    return defined($s) ? $s : 0;
}

sub by_mixed {
    my $aa = $a;
    my $bb = $b;
    return $aa <=> $bb if $aa =~ /^\d+\z/ && $bb =~ /^\d+\z/;
    return $aa cmp $bb;
}

sub board_from_filename {
    my ($file) = @_;
    my $base = basename($file);
    return $1 if $base =~ /_(AMY|BOB|CY|DAN|ED|FLO|GUY)_/i;
    return $1 if $base =~ /\b(AMY|BOB|CY|DAN|ED|FLO|GUY)\b/i;
    return $base;
}

sub trim {
    my ($v) = @_;
    $v = '' unless defined $v;
    $v =~ s/^\s+//;
    $v =~ s/\s+\z//;
    return $v;
}

sub shellq {
    my ($s) = @_;
    $s =~ s/'/'"'"'/g;
    return "'$s'";
}

sub csvq {
    my ($v) = @_;
    $v = '' unless defined $v;
    $v =~ s/"/""/g;
    return '"' . $v . '"';
}

sub usage {
    return <<'USAGE';
Usage:
  analyze_tbeam_bilateral_transfer_20260520_0412.pl [options] log1.log log2.log
  analyze_tbeam_bilateral_transfer_20260520_0412.pl [options] BLE_CY_DAN_20260519_2051.zip

Options:
  --detail              Print detailed RX DATA rows.
  --csv FILE            Write normalized TX/RX/error rows to CSV.
  --report FILE         Write the report to FILE instead of STDOUT.
  --keep-extract        Keep temporary extraction directory when reading .zip input.
  --help                Show this help.

Examples:
  chmod 755 analyze_tbeam_bilateral_transfer_20260520_0412.pl

  ./analyze_tbeam_bilateral_transfer_20260520_0412.pl \
    BLE_CY_DAN_20260519_2051.zip

  ./analyze_tbeam_bilateral_transfer_20260520_0412.pl \
    --detail \
    --csv tbeam_chunks_$(date +%Y%m%d_%H%M).csv \
    --report tbeam_report_$(date +%Y%m%d_%H%M).txt \
    BLE_CY_DAN_20260519_2051.zip
USAGE
}
