ble-reticulum/scripts/analyze_reticulum_latency.pl

#!/usr/bin/env perl
# ./analyze_reticulum_latency_20260516_0842.pl 20250516_0836_zerodev1.txt 20250516_0836_zerodev2.txt
# chmod 755 analyze_reticulum_latency_20260516_0842.pl
# 2026-05-16 ChatGPT
# $Header$
# $HeadURL$

use strict;
use warnings;
use POSIX qw(strftime);
use Time::Local qw(timegm);
use List::Util qw(min max sum);

my $usage = "Usage: $0 node1.log node2.log [more.log ...]\n";
@ARGV >= 2 or die $usage;

my %mon = (
    Jan => 0, Feb => 1, Mar => 2, Apr => 3, May => 4, Jun => 5,
    Jul => 6, Aug => 7, Sep => 8, Oct => 9, Nov => 10, Dec => 11,
);

my %tz_offset = (
    UTC => 0,
    GMT => 0,
    PST => -8 * 3600,
    PDT => -7 * 3600,
);

my @rows;
my %by_dir;

for my $file (@ARGV) {
    open my $fh, '<', $file or die "Cannot open $file: $!\n";

    my $first = <$fh>;
    defined $first or die "Empty file: $file\n";
    chomp $first;

    my ($year, $month, $day, $tz) = parse_log_date($first);
    my $receiver = receiver_from_filename($file);

    while (my $line = <$fh>) {
        chomp $line;

        # Example:
        # [08:33:11.753] RX link=<...>: hello from zerodev2 send_epoch=1778945591.644050
        next unless $line =~ /^\[(\d\d):(\d\d):(\d\d)\.(\d{3})\]\s+RX\s+.*?:\s+(.+?)\s+from\s+(\S+)\s+send_epoch=([0-9]+(?:\.[0-9]+)?)/;

        my ($hh, $mi, $ss, $ms, $message, $sender, $send_epoch) = ($1, $2, $3, $4, $5, $6, $7);

        my $recv_epoch = epoch_from_local_parts($year, $month, $day, $hh, $mi, $ss, $ms, $tz);
        my $latency = $recv_epoch - $send_epoch;

        my $row = {
            file       => $file,
            sender     => $sender,
            receiver   => $receiver,
            message    => $message,
            send_epoch => $send_epoch + 0.0,
            recv_epoch => $recv_epoch + 0.0,
            latency    => $latency + 0.0,
            line       => $line,
        };

        push @rows, $row;
        push @{ $by_dir{"$sender->$receiver"} }, $row;
    }

    close $fh;
}

if (!@rows) {
    die "No RX lines with send_epoch= were found. Add send_epoch to the payload before running this analyzer.\n";
}

print "Reticulum BLE latency analysis\n";
print "Generated: ", strftime('%Y-%m-%d %H:%M:%S %Z', localtime), "\n";
print "Input files:\n";
print "  $_\n" for @ARGV;
print "\n";

for my $dir (sort keys %by_dir) {
    my @lat = map { $_->{latency} } @{ $by_dir{$dir} };
    my $n = scalar @lat;
    my $mean = sum(@lat) / $n;
    my $median = percentile(50, @lat);
    my $p95 = percentile(95, @lat);
    my $stddev = stddev(@lat);

    printf "Direction: %s\n", $dir;
    printf "  samples : %d\n", $n;
    printf "  min     : %.6f s  %.3f ms\n", min(@lat), min(@lat) * 1000.0;
    printf "  median  : %.6f s  %.3f ms\n", $median, $median * 1000.0;
    printf "  mean    : %.6f s  %.3f ms\n", $mean, $mean * 1000.0;
    printf "  p95     : %.6f s  %.3f ms\n", $p95, $p95 * 1000.0;
    printf "  max     : %.6f s  %.3f ms\n", max(@lat), max(@lat) * 1000.0;
    printf "  stddev  : %.6f s  %.3f ms\n", $stddev, $stddev * 1000.0;
    print  "\n";
}

print "Per-message detail:\n";
printf "%10s %-10s %-10s %-18s %12s\n", 'lat_ms', 'sender', 'receiver', 'message', 'recv_minus_send';
for my $r (sort { $a->{recv_epoch} <=> $b->{recv_epoch} } @rows) {
    printf "%10.3f %-10s %-10s %-18s %12.6f\n",
        $r->{latency} * 1000.0,
        $r->{sender},
        $r->{receiver},
        $r->{message},
        $r->{latency};
}

print "\n";
print "Caution: one-way latency assumes sender and receiver clocks are synchronized.\n";
print "For tighter measurement, include chronyc tracking output near the run, or use echo/ACK round-trip timestamps.\n";

sub parse_log_date {
    my ($line) = @_;

    # Supports:
    # Sat May 16 08:32:49 PDT 2026
    # Sat May 16 08:32:51 AM PDT 2026
    if ($line =~ /^\S+\s+(\S+)\s+(\d{1,2})\s+\d\d:\d\d:\d\d(?:\s+(?:AM|PM))?\s+(\S+)\s+(\d{4})/i) {
        my ($mon_name, $day, $tz, $year) = ($1, $2, uc($3), $4);
        exists $mon{$mon_name} or die "Cannot parse month '$mon_name' in: $line\n";
        exists $tz_offset{$tz} or die "Unknown timezone '$tz' in: $line\nAdd it to %tz_offset.\n";
        return ($year, $mon{$mon_name}, $day, $tz);
    }

    die "Cannot parse log date from first line: $line\n";
}

sub epoch_from_local_parts {
    my ($year, $month, $day, $hh, $mi, $ss, $ms, $tz) = @_;
    my $epoch_as_if_utc = timegm($ss, $mi, $hh, $day, $month, $year - 1900);
    return $epoch_as_if_utc - $tz_offset{$tz} + ($ms / 1000.0);
}

sub receiver_from_filename {
    my ($file) = @_;
    return $1 if $file =~ /(zerodev\d+)/;
    return $file;
}

sub percentile {
    my ($p, @values) = @_;
    @values = sort { $a <=> $b } @values;
    return undef 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 stddev {
    my (@values) = @_;
    return 0 if @values < 2;
    my $mean = sum(@values) / @values;
    my $ss = 0;
    $ss += ($_ - $mean) ** 2 for @values;
    return sqrt($ss / @values);
}