Adding Perl script to analyze run results, adding feature of message file and determining if Announce needs to be repeated

scripts/analyze_reticulum_latency.pl

@@ -0,0 +1,166 @@
+#!/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);
+}