sync SVN r18206
This commit is contained in:
163
.archon/scripts/raport_context.pl
Normal file
163
.archon/scripts/raport_context.pl
Normal file
@@ -0,0 +1,163 @@
|
||||
#!/usr/bin/perl
|
||||
# Genereaza tabelul de varf-context + timp per nod pentru o rulare roa-fix.
|
||||
# Sursa: archon.db (evenimente node_started/node_completed, exacte) pentru
|
||||
# fereastra de timp a fiecarui nod, apoi sesiunile brute de pe disc (Claude
|
||||
# .jsonl / Pi .jsonl) pentru varful REAL de context (max per apel, nu suma).
|
||||
# Vezi docs/pilot_archon_diagnoza_47.md, sectiunea "Finalizare workflow".
|
||||
use strict; use warnings;
|
||||
use JSON::PP;
|
||||
use Time::Local;
|
||||
|
||||
my ($run_id) = @ARGV; # opțional; gol/lipsă -> auto-detectat (ultimul run roa-fix din archon.db)
|
||||
my $SCRIPT_DIR = $0; $SCRIPT_DIR =~ s{[\\/][^\\/]+$}{};
|
||||
my $SQLITE = "D:/roa/roacont/sqlite3.exe";
|
||||
my $DB = "C:/Users/mmari/.archon/archon.db";
|
||||
my $CLAUDE_DIR = "C:/Users/mmari/.claude/projects/D--ROA-ROACONT";
|
||||
my $PI_DIR = "C:/Users/mmari/.pi/agent/sessions/--D--ROA-ROACONT--";
|
||||
my $THRESHOLD = 200000;
|
||||
|
||||
# nod -> provider, doar nodurile AI din roa-fix.yaml (bash/approval sar peste)
|
||||
my %PROVIDER = (
|
||||
plan => 'claude',
|
||||
plan_review => 'claude',
|
||||
implement => 'pi',
|
||||
implement_retry => 'pi',
|
||||
escaladare => 'claude',
|
||||
review => 'pi',
|
||||
escaladare_review => 'claude',
|
||||
review2 => 'pi',
|
||||
invatare => 'claude',
|
||||
aplica_doc => 'pi',
|
||||
);
|
||||
my @ORDER = qw(plan plan_review implement implement_retry escaladare review escaladare_review review2 invatare aplica_doc);
|
||||
|
||||
sub sqlite_rows {
|
||||
# -ascii: coloane separate cu 0x1F, RANDURI separate cu 0x1E (nu \n) - unele
|
||||
# campuri (ex. eroarea PowerShell capturata de nodul `verifica`) contin \r\n
|
||||
# BRUT, necodat, in JSON-ul din coloana `data`; citirea linie-cu-linie (\n)
|
||||
# desincroniza toate randurile de dupa primul astfel de camp si raporta
|
||||
# gresit "toate nodurile skipped" (confirmat 25.09 pe run-ul real 3c029727,
|
||||
# vezi docs/pilot_archon_diagnoza_47.md). 0x1E nu apare in text normal.
|
||||
my ($sql) = @_;
|
||||
open(my $fh, "-|", $SQLITE, "-ascii", $DB, $sql) or die "sqlite3: $!";
|
||||
local $/;
|
||||
my $out = <$fh> // '';
|
||||
close $fh;
|
||||
my @rows;
|
||||
for my $rec (split /\x1e/, $out) {
|
||||
next if $rec eq '' || $rec eq "\n";
|
||||
push @rows, [split /\x1f/, $rec, -1];
|
||||
}
|
||||
return @rows;
|
||||
}
|
||||
|
||||
sub iso_to_epoch_ms {
|
||||
my ($s) = @_; # "YYYY-MM-DD HH:MM:SS" (UTC, din sqlite datetime('now'))
|
||||
return 0 unless $s && $s =~ /^(\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)/;
|
||||
return timegm($6,$5,$4,$3,$2-1,$1) * 1000;
|
||||
}
|
||||
sub epoch_ms_to_iso { # -> "YYYY-MM-DDTHH:MM:SS.000Z" (pt claude_extract.pl/pi_extract.pl)
|
||||
my ($ms) = @_;
|
||||
my @t = gmtime(int($ms/1000));
|
||||
return sprintf("%04d-%02d-%02dT%02d:%02d:%02d.000Z", $t[5]+1900,$t[4]+1,$t[3],$t[2],$t[1],$t[0]);
|
||||
}
|
||||
|
||||
unless ($run_id) {
|
||||
my @rows = sqlite_rows("SELECT id FROM remote_agent_workflow_runs WHERE workflow_name='roa-fix' AND working_path LIKE '%ROACONT%' ORDER BY started_at DESC LIMIT 1;");
|
||||
$run_id = $rows[0] ? $rows[0][0] : '';
|
||||
}
|
||||
unless ($run_id) {
|
||||
print "Nu am gasit niciun run roa-fix in archon.db (working_path ROACONT). Tabel neconstruit.\n";
|
||||
exit 0;
|
||||
}
|
||||
print "run_id folosit: $run_id\n";
|
||||
|
||||
# ia ULTIMUL node_completed per step_name (in caz de resume/retry pe acelasi run_id)
|
||||
my @evrows = sqlite_rows("SELECT step_name, created_at, data FROM remote_agent_workflow_events WHERE workflow_run_id='$run_id' AND event_type='node_completed' ORDER BY event_order;");
|
||||
my %node; # step_name -> {end_ms, duration_ms}
|
||||
for my $r (@evrows) {
|
||||
my ($step, $created_at, $data) = @$r;
|
||||
next unless exists $PROVIDER{$step};
|
||||
my $obj = eval { decode_json($data) };
|
||||
next unless $obj && defined $obj->{duration_ms};
|
||||
my $end_ms = iso_to_epoch_ms($created_at);
|
||||
$node{$step} = { end_ms => $end_ms, duration_ms => $obj->{duration_ms} };
|
||||
}
|
||||
|
||||
sub find_claude_file {
|
||||
my ($end_ms) = @_;
|
||||
return undef unless -d $CLAUDE_DIR;
|
||||
opendir(my $dh, $CLAUDE_DIR) or return undef;
|
||||
my ($best, $bestdiff);
|
||||
for my $f (readdir $dh) {
|
||||
next unless $f =~ /\.jsonl$/;
|
||||
my $path = "$CLAUDE_DIR/$f";
|
||||
my @st = stat($path); next unless @st;
|
||||
my $mtime_ms = $st[9] * 1000;
|
||||
my $diff = $mtime_ms - $end_ms; # asteptat >=0, fisierul se scrie la/dupa finalul nodului
|
||||
next if $diff < -5000 || $diff > 120000; # toleranta -5s..+120s
|
||||
if (!defined($bestdiff) || abs($diff) < abs($bestdiff)) { $best = $path; $bestdiff = $diff; }
|
||||
}
|
||||
closedir $dh;
|
||||
return $best;
|
||||
}
|
||||
|
||||
sub find_pi_file {
|
||||
my ($start_ms) = @_;
|
||||
return undef unless -d $PI_DIR;
|
||||
opendir(my $dh, $PI_DIR) or return undef;
|
||||
my ($best, $bestdiff);
|
||||
for my $f (readdir $dh) {
|
||||
next unless $f =~ /^(\d{4})-(\d{2})-(\d{2})T(\d{2})-(\d{2})-(\d{2})-(\d{3})Z_/;
|
||||
my $fts_ms = timegm($6,$5,$4,$3,$2-1,$1) * 1000 + $7;
|
||||
my $diff = $fts_ms - $start_ms;
|
||||
next if abs($diff) > 5000; # numele fisierului Pi contine timestamp-ul de start exact
|
||||
if (!defined($bestdiff) || abs($diff) < abs($bestdiff)) { $best = "$PI_DIR/$f"; $bestdiff = $diff; }
|
||||
}
|
||||
closedir $dh;
|
||||
return $best;
|
||||
}
|
||||
|
||||
my @table; # {node, provider, duration_s, peak, note}
|
||||
for my $nid (@ORDER) {
|
||||
my $n = $node{$nid};
|
||||
unless ($n) {
|
||||
push @table, { node=>$nid, provider=>$PROVIDER{$nid}, duration_s=>'-', peak=>'-', note=>'nu a rulat (skipped)' };
|
||||
next;
|
||||
}
|
||||
my $provider = $PROVIDER{$nid};
|
||||
my $start_ms = $n->{end_ms} - $n->{duration_ms};
|
||||
my $duration_s = sprintf("%.1f", $n->{duration_ms}/1000);
|
||||
my ($peak, $note) = ('?', '');
|
||||
if ($provider eq 'claude') {
|
||||
my $file = find_claude_file($n->{end_ms});
|
||||
if ($file) {
|
||||
my $start_iso = epoch_ms_to_iso($start_ms - 2000);
|
||||
my $end_iso = epoch_ms_to_iso($n->{end_ms} + 2000);
|
||||
my $out = `perl "$SCRIPT_DIR/claude_extract.pl" "$file" "$start_iso" "$end_iso" 2>&1`;
|
||||
if ($out =~ /max context[^:]*:\s*(\d+)/) { $peak = $1; }
|
||||
$note = "fisier: $file";
|
||||
} else {
|
||||
$note = 'sesiune Claude negasita (fereastra de timp fara potrivire)';
|
||||
}
|
||||
} else {
|
||||
my $file = find_pi_file($start_ms);
|
||||
if ($file) {
|
||||
my $start_iso = epoch_ms_to_iso($start_ms);
|
||||
my $out = `perl "$SCRIPT_DIR/pi_extract.pl" "$file" "$start_iso" 2>&1`;
|
||||
if ($out =~ /max single-call input:\s*(\d+)/) { $peak = $1; }
|
||||
$note = "fisier: $file";
|
||||
} else {
|
||||
$note = 'sesiune Pi negasita (fereastra de timp fara potrivire)';
|
||||
}
|
||||
}
|
||||
if ($peak ne '?' && $peak >= $THRESHOLD) { $note = "ATENTIE: varf $peak >= $THRESHOLD. $note"; }
|
||||
push @table, { node=>$nid, provider=>$provider, duration_s=>$duration_s, peak=>$peak, note=>$note };
|
||||
}
|
||||
|
||||
print "\n| nod | provider | durata (s) | varf context | nota |\n";
|
||||
print "|---|---|---|---|---|\n";
|
||||
for my $row (@table) {
|
||||
my $flag = ($row->{peak} ne '?' && $row->{peak} ne '-' && $row->{peak} >= $THRESHOLD) ? 'ATENTIE' : '';
|
||||
printf "| %s | %s | %s | %s | %s %s |\n", $row->{node}, $row->{provider}, $row->{duration_s}, $row->{peak}, $flag, $row->{note};
|
||||
}
|
||||
Reference in New Issue
Block a user