sync SVN r18206
This commit is contained in:
90
.archon/scripts/analyze_claude.pl
Normal file
90
.archon/scripts/analyze_claude.pl
Normal file
@@ -0,0 +1,90 @@
|
||||
#!/usr/bin/perl
|
||||
use strict; use warnings;
|
||||
use JSON::PP;
|
||||
my $file = shift @ARGV or die "usage: analyze_claude.pl <file.jsonl>\n";
|
||||
my $json = JSON::PP->new;
|
||||
my %calls; # id -> {name, args, reqts(epoch ms)}
|
||||
my @results;
|
||||
open my $fh, '<:encoding(UTF-8)', $file or die $!;
|
||||
sub to_epoch {
|
||||
my $iso = shift;
|
||||
return undef unless $iso;
|
||||
# 2026-09-24T22:48:53.885Z
|
||||
if ($iso =~ /^(\d+)-(\d+)-(\d+)T(\d+):(\d+):(\d+)(?:\.(\d+))?Z$/) {
|
||||
my ($Y,$Mo,$D,$H,$Mi,$S,$ms) = ($1,$2,$3,$4,$5,$6,$7//0);
|
||||
require Time::Local;
|
||||
my $epoch = Time::Local::timegm($S,$Mi,$H,$D,$Mo-1,$Y);
|
||||
return $epoch*1000 + $ms;
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
while (my $line = <$fh>) {
|
||||
chomp $line;
|
||||
next unless length $line;
|
||||
my $obj = eval { $json->decode($line) };
|
||||
next unless $obj;
|
||||
my $ts = to_epoch($obj->{timestamp});
|
||||
my $msg = $obj->{message} or next;
|
||||
my $role = $msg->{role} // '';
|
||||
my $content = $msg->{content};
|
||||
next unless ref($content) eq 'ARRAY';
|
||||
if ($role eq 'assistant') {
|
||||
for my $c (@$content) {
|
||||
next unless ($c->{type}//'') eq 'tool_use';
|
||||
my $args = '';
|
||||
if (ref($c->{input}) eq 'HASH') {
|
||||
$args = $c->{input}{command} // $c->{input}{file_path} // $c->{input}{pattern} // '';
|
||||
$args = substr((eval{$json->encode($c->{input})}//''),0,200) unless $args;
|
||||
}
|
||||
$calls{$c->{id}} = { name => $c->{name}, args => $args, reqts => $ts };
|
||||
}
|
||||
} elsif ($role eq 'user') {
|
||||
for my $c (@$content) {
|
||||
next unless ($c->{type}//'') eq 'tool_result';
|
||||
my $iserror = $c->{is_error} ? 1 : 0;
|
||||
my $snippet = '';
|
||||
if ($iserror) {
|
||||
my $ct = $c->{content};
|
||||
if (ref($ct) eq 'ARRAY') { $snippet = substr($ct->[0]{text}//'',0,300); }
|
||||
elsif (!ref($ct)) { $snippet = substr($ct//'',0,300); }
|
||||
}
|
||||
push @results, { id => $c->{tool_use_id}, rests => $ts, iserror => $iserror, snippet => $snippet };
|
||||
}
|
||||
}
|
||||
}
|
||||
close $fh;
|
||||
|
||||
my @rows;
|
||||
for my $r (@results) {
|
||||
my $c = $calls{$r->{id}} or next;
|
||||
my $dur = ($r->{rests} && $c->{reqts}) ? ($r->{rests} - $c->{reqts}) : undef;
|
||||
push @rows, { name => $c->{name}, args => $c->{args}, dur => $dur, iserror => $r->{iserror}, snippet => $r->{snippet} };
|
||||
}
|
||||
|
||||
my %cnt; $cnt{$_->{name}}++ for @rows;
|
||||
print "=== tool counts ===\n";
|
||||
for my $k (sort { $cnt{$b} <=> $cnt{$a} } keys %cnt) { print "$k: $cnt{$k}\n"; }
|
||||
|
||||
print "\n=== top 10 longest ===\n";
|
||||
my @sorted = sort { ($b->{dur}//0) <=> ($a->{dur}//0) } @rows;
|
||||
for my $i (0..9) {
|
||||
last unless $sorted[$i];
|
||||
my $row = $sorted[$i];
|
||||
my $a = $row->{args}; $a =~ s/\s+/ /g; $a = substr($a,0,100);
|
||||
printf "%8dms %-10s %s\n", ($row->{dur}//-1), $row->{name}, $a;
|
||||
}
|
||||
|
||||
print "\n=== errors ===\n";
|
||||
my $ec = 0;
|
||||
for my $row (@rows) {
|
||||
next unless $row->{iserror};
|
||||
$ec++;
|
||||
my $a = $row->{args}; $a =~ s/\s+/ /g; $a = substr($a,0,150);
|
||||
my $s = $row->{snippet}; $s =~ s/\s+/ /g; $s = substr($s,0,200);
|
||||
print "dur=".($row->{dur}//'?')."ms CMD: $a\n ERR: $s\n";
|
||||
}
|
||||
print "total errors: $ec\n";
|
||||
|
||||
my $totaldur = 0; $totaldur += ($_->{dur}//0) for @rows;
|
||||
print "\n=== total tool time (sum durations, ms) === $totaldur\n";
|
||||
print "=== total tool calls with duration === " . scalar(@rows) . "\n";
|
||||
81
.archon/scripts/analyze_pi.pl
Normal file
81
.archon/scripts/analyze_pi.pl
Normal file
@@ -0,0 +1,81 @@
|
||||
#!/usr/bin/perl
|
||||
use strict; use warnings;
|
||||
use JSON::PP;
|
||||
my $file = shift @ARGV or die "usage: analyze_pi.pl <file.jsonl> [startline] [endline]\n";
|
||||
my $startline = shift @ARGV || 1;
|
||||
my $endline = shift @ARGV || 1e9;
|
||||
my $json = JSON::PP->new;
|
||||
my %calls; # id -> {name, args, reqts}
|
||||
my @results; # {id, name, rests, iserror, errsnippet}
|
||||
open my $fh, '<:encoding(UTF-8)', $file or die $!;
|
||||
my $ln = 0;
|
||||
while (my $line = <$fh>) {
|
||||
$ln++;
|
||||
next if $ln < $startline || $ln > $endline;
|
||||
chomp $line;
|
||||
next unless length $line;
|
||||
my $obj = eval { $json->decode($line) };
|
||||
next unless $obj;
|
||||
my $msg = $obj->{message} or next;
|
||||
if (($msg->{role} // '') eq 'assistant') {
|
||||
my $ts = $msg->{timestamp};
|
||||
for my $c (@{$msg->{content} || []}) {
|
||||
next unless ($c->{type} // '') eq 'toolCall';
|
||||
my $argstr = '';
|
||||
if ($c->{arguments}) {
|
||||
$argstr = $c->{arguments}{command} // $c->{arguments}{path} // $c->{arguments}{pattern} // encode_json_short($c->{arguments});
|
||||
}
|
||||
$calls{$c->{id}} = { name => $c->{name}, args => $argstr, reqts => $ts };
|
||||
}
|
||||
} elsif (($msg->{role} // '') eq 'toolResult') {
|
||||
my $ts = $msg->{timestamp};
|
||||
my $iserror = $msg->{isError} ? 1 : 0;
|
||||
my $snippet = '';
|
||||
if ($iserror) {
|
||||
for my $c (@{$msg->{content} || []}) {
|
||||
if (($c->{type}//'') eq 'text') { $snippet = substr($c->{text}//'',0,300); last; }
|
||||
}
|
||||
}
|
||||
push @results, { id => $msg->{toolCallId}, name => $msg->{toolName}, rests => $ts, iserror => $iserror, snippet => $snippet };
|
||||
}
|
||||
}
|
||||
close $fh;
|
||||
|
||||
sub encode_json_short { my $h = shift; my $s = eval { $json->encode($h) } // ''; return substr($s,0,200); }
|
||||
|
||||
# join
|
||||
my @rows;
|
||||
for my $r (@results) {
|
||||
my $c = $calls{$r->{id}};
|
||||
next unless $c;
|
||||
my $dur = ($r->{rests} && $c->{reqts}) ? ($r->{rests} - $c->{reqts}) : undef;
|
||||
push @rows, { name => $c->{name}, args => $c->{args}, dur => $dur, iserror => $r->{iserror}, snippet => $r->{snippet}, reqts=>$c->{reqts}, rests=>$r->{rests} };
|
||||
}
|
||||
|
||||
# counts by tool name
|
||||
my %cnt;
|
||||
$cnt{$_->{name}}++ for @rows;
|
||||
print "=== tool counts ===\n";
|
||||
for my $k (sort { $cnt{$b} <=> $cnt{$a} } keys %cnt) { print "$k: $cnt{$k}\n"; }
|
||||
|
||||
print "\n=== top 10 longest ===\n";
|
||||
my @sorted = sort { ($b->{dur}//0) <=> ($a->{dur}//0) } @rows;
|
||||
for my $i (0..9) {
|
||||
last unless $sorted[$i];
|
||||
my $row = $sorted[$i];
|
||||
my $a = $row->{args}; $a =~ s/\s+/ /g; $a = substr($a,0,100);
|
||||
printf "%8dms %-6s %s\n", ($row->{dur}//-1), $row->{name}, $a;
|
||||
}
|
||||
|
||||
print "\n=== errors ===\n";
|
||||
for my $row (@rows) {
|
||||
next unless $row->{iserror};
|
||||
my $a = $row->{args}; $a =~ s/\s+/ /g; $a = substr($a,0,150);
|
||||
my $s = $row->{snippet}; $s =~ s/\s+/ /g; $s = substr($s,0,200);
|
||||
print "reqts=$row->{reqts} rests=$row->{rests} dur=".($row->{dur}//'?')."ms\n CMD: $a\n ERR: $s\n";
|
||||
}
|
||||
|
||||
my $totaldur = 0;
|
||||
$totaldur += ($_->{dur}//0) for @rows;
|
||||
print "\n=== total tool time (sum durations, ms) === $totaldur\n";
|
||||
print "=== total tool calls with duration === " . scalar(@rows) . "\n";
|
||||
94
.archon/scripts/claude_extract.pl
Normal file
94
.archon/scripts/claude_extract.pl
Normal file
@@ -0,0 +1,94 @@
|
||||
#!/usr/bin/perl
|
||||
use strict; use warnings;
|
||||
use JSON::PP;
|
||||
use Time::Local;
|
||||
|
||||
my ($file, $cutoff_start_iso, $cutoff_end_iso) = @ARGV; # optional: only count entries in [start,end]
|
||||
|
||||
sub iso_to_epoch {
|
||||
my ($s) = @_;
|
||||
return 0 unless defined $s;
|
||||
if ($s =~ /(\d+)-(\d+)-(\d+)T(\d+):(\d+):(\d+)\.(\d+)Z/) {
|
||||
return timegm($6,$5,$4,$3,$2-1,$1) * 1000 + $7;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
my $cutoff_start = $cutoff_start_iso ? iso_to_epoch($cutoff_start_iso) : 0;
|
||||
my $cutoff_end = $cutoff_end_iso ? iso_to_epoch($cutoff_end_iso) : 0;
|
||||
|
||||
open(my $fh, "<:encoding(UTF-8)", $file) or die $!;
|
||||
my $nAssistant=0; my %toolCounts;
|
||||
my %callById; # toolu_id -> {name,input,issued_ts}
|
||||
my @durs; my @errs;
|
||||
my $maxCtx=0; my $sumIn=0; my $sumOut=0;
|
||||
my $firstTs; my $lastTs;
|
||||
|
||||
while (my $line = <$fh>) {
|
||||
chomp $line;
|
||||
next unless $line;
|
||||
my $obj = eval { decode_json($line) };
|
||||
next unless $obj;
|
||||
my $ts = iso_to_epoch($obj->{timestamp});
|
||||
next unless $ts;
|
||||
next if $cutoff_start && $ts < $cutoff_start;
|
||||
next if $cutoff_end && $ts > $cutoff_end;
|
||||
$firstTs = $ts if !defined($firstTs) || $ts < $firstTs;
|
||||
$lastTs = $ts if !defined($lastTs) || $ts > $lastTs;
|
||||
|
||||
if ($obj->{type} eq 'assistant') {
|
||||
$nAssistant++;
|
||||
my $msg = $obj->{message};
|
||||
my $usage = $msg->{usage};
|
||||
if ($usage) {
|
||||
my $ctx = ($usage->{input_tokens}//0) + ($usage->{cache_read_input_tokens}//0) + ($usage->{cache_creation_input_tokens}//0);
|
||||
$maxCtx = $ctx if $ctx > $maxCtx;
|
||||
$sumIn += $ctx; $sumOut += ($usage->{output_tokens}//0);
|
||||
}
|
||||
for my $c (@{$msg->{content}}) {
|
||||
if ($c->{type} eq 'tool_use') {
|
||||
$toolCounts{$c->{name}}++;
|
||||
$callById{$c->{id}} = { name=>$c->{name}, input=>encode_json($c->{input}), issued=>$ts };
|
||||
}
|
||||
}
|
||||
} elsif ($obj->{type} eq 'user') {
|
||||
my $msg = $obj->{message};
|
||||
next unless ref($msg->{content}) eq 'ARRAY';
|
||||
for my $c (@{$msg->{content}}) {
|
||||
next unless $c->{type} && $c->{type} eq 'tool_result';
|
||||
my $tcid = $c->{tool_use_id};
|
||||
my $call = $callById{$tcid};
|
||||
next unless $call;
|
||||
my $dur = $ts - $call->{issued};
|
||||
my $isErr = $c->{is_error} ? 1 : 0;
|
||||
my $text = ref($c->{content}) ? encode_json($c->{content}) : ($c->{content}//'');
|
||||
push @durs, { name=>$call->{name}, input=>$call->{input}, dur=>$dur, isError=>$isErr, err=>substr($text,0,200) };
|
||||
push @errs, $durs[-1] if $isErr;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@durs = sort { $b->{dur} <=> $a->{dur} } @durs;
|
||||
|
||||
print "=== $file ===\n";
|
||||
print "cutoff: $cutoff_start_iso .. ", ($cutoff_end_iso//''), "\n" if $cutoff_start_iso;
|
||||
print "assistant turns: $nAssistant\n";
|
||||
print "tool calls total: ", scalar(keys %callById), "\n";
|
||||
print "tool calls by type: "; for my $k (sort keys %toolCounts) { print "$k=$toolCounts{$k} "; } print "\n";
|
||||
print "max context (in+cache_read+cache_creation) single call: $maxCtx sum_in(approx): $sumIn sum_out: $sumOut\n";
|
||||
print "span: ", (($lastTs-$firstTs)//0)/1000, "s\n";
|
||||
my $toolTimeSum = 0; $toolTimeSum += $_->{dur} for @durs;
|
||||
print "total tool time (sum all calls): ", $toolTimeSum/1000, "s\n";
|
||||
print "--- top 10 longest tool calls ---\n";
|
||||
for my $i (0..9) {
|
||||
last unless $durs[$i];
|
||||
my $d = $durs[$i];
|
||||
my $a = $d->{input}; $a =~ s/\s+/ /g; $a = substr($a,0,100);
|
||||
printf("%7.1fs %-10s %s %s\n", $d->{dur}/1000, $d->{name}, $a, ($d->{isError}?"ERROR":""));
|
||||
}
|
||||
print "--- errors (", scalar(@errs), ") ---\n";
|
||||
for my $d (@errs) {
|
||||
my $a = $d->{input}; $a =~ s/\s+/ /g; $a = substr($a,0,100);
|
||||
my $e = $d->{err}; $e =~ s/\s+/ /g;
|
||||
print "$d->{name} $a :: $e\n";
|
||||
}
|
||||
# sum total tool time (appended quick calc, reuse @durs if still in scope - not, so separate script)
|
||||
104
.archon/scripts/pi_extract.pl
Normal file
104
.archon/scripts/pi_extract.pl
Normal file
@@ -0,0 +1,104 @@
|
||||
#!/usr/bin/perl
|
||||
use strict; use warnings;
|
||||
use JSON::PP;
|
||||
use Time::Local;
|
||||
|
||||
my ($file, $cutoff_iso) = @ARGV; # cutoff_iso optional: only count entries with timestamp >= this
|
||||
my $cutoff = 0;
|
||||
if ($cutoff_iso) {
|
||||
$cutoff = iso_to_epoch($cutoff_iso);
|
||||
}
|
||||
|
||||
sub iso_to_epoch {
|
||||
my ($s) = @_;
|
||||
return 0 unless defined $s;
|
||||
if ($s =~ /^\d+$/) { return $s + 0; } # already epoch ms
|
||||
if ($s =~ /(\d+)-(\d+)-(\d+)T(\d+):(\d+):(\d+)\.(\d+)Z/) {
|
||||
return timegm($6,$5,$4,$3,$2-1,$1) * 1000 + $7;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
open(my $fh, "<:encoding(UTF-8)", $file) or die $!;
|
||||
my @msgs;
|
||||
while (my $line = <$fh>) {
|
||||
chomp $line;
|
||||
next unless $line;
|
||||
my $obj = eval { decode_json($line) };
|
||||
next unless $obj;
|
||||
next unless $obj->{type} eq "message";
|
||||
my $ts = iso_to_epoch($obj->{message}{timestamp} // $obj->{timestamp} // '');
|
||||
next if $cutoff && $ts < $cutoff;
|
||||
push @msgs, { obj=>$obj, ts=>$ts };
|
||||
}
|
||||
|
||||
my $nAssistant=0; my %toolCounts; my @calls; # each: name,args,issued_ts,id
|
||||
my %callById;
|
||||
my @results; # {id, ts, isError, textlen}
|
||||
my $totalInTok=0; my $totalOutTok=0; my $maxInTok=0;
|
||||
my $firstTs; my $lastTs;
|
||||
|
||||
for my $m (@msgs) {
|
||||
my $obj = $m->{obj};
|
||||
my $role = $obj->{message}{role} // '?';
|
||||
$firstTs = $m->{ts} if !defined($firstTs) || $m->{ts} < $firstTs;
|
||||
$lastTs = $m->{ts} if !defined($lastTs) || $m->{ts} > $lastTs;
|
||||
if ($role eq 'assistant') {
|
||||
$nAssistant++;
|
||||
my $usage = $obj->{message}{usage};
|
||||
if ($usage) {
|
||||
my $in = $usage->{input} // $usage->{inputTokens} // $usage->{prompt_tokens} // 0;
|
||||
my $out = $usage->{output} // $usage->{outputTokens} // $usage->{completion_tokens} // 0;
|
||||
$totalInTok += $in; $totalOutTok += $out;
|
||||
$maxInTok = $in if $in > $maxInTok;
|
||||
}
|
||||
for my $c (@{$obj->{message}{content}}) {
|
||||
if ($c->{type} eq 'toolCall') {
|
||||
$toolCounts{$c->{name}}++;
|
||||
my $argstr = encode_json($c->{arguments});
|
||||
$callById{$c->{id}} = { name=>$c->{name}, args=>$argstr, issued=>$m->{ts} };
|
||||
}
|
||||
}
|
||||
} elsif ($role eq 'toolResult') {
|
||||
my $tcid = $obj->{message}{toolCallId};
|
||||
my $isErr = $obj->{message}{isError} ? 1 : 0;
|
||||
my $text = '';
|
||||
for my $c (@{$obj->{message}{content}}) { $text .= ($c->{text}//'') if $c->{type} eq 'text'; }
|
||||
push @results, { id=>$tcid, ts=>$m->{ts}, isError=>$isErr, text=>substr($text,0,200) };
|
||||
}
|
||||
}
|
||||
|
||||
# compute durations: result.ts - issued.ts (per call)
|
||||
my @durs;
|
||||
for my $r (@results) {
|
||||
my $c = $callById{$r->{id}};
|
||||
next unless $c;
|
||||
my $dur = $r->{ts} - $c->{issued};
|
||||
push @durs, { name=>$c->{name}, args=>$c->{args}, dur=>$dur, isError=>$r->{isError}, err=>$r->{text} };
|
||||
}
|
||||
@durs = sort { $b->{dur} <=> $a->{dur} } @durs;
|
||||
|
||||
print "=== $file ===\n";
|
||||
print "cutoff: $cutoff_iso ($cutoff)\n" if $cutoff_iso;
|
||||
print "assistant turns: $nAssistant\n";
|
||||
print "tool calls total: ", scalar(keys %callById), "\n";
|
||||
print "tool calls by type: "; for my $k (sort keys %toolCounts) { print "$k=$toolCounts{$k} "; } print "\n";
|
||||
print "total input tokens (sum): $totalInTok max single-call input: $maxInTok total output tokens: $totalOutTok\n";
|
||||
print "span: ", ($lastTs-$firstTs)/1000, "s first=$firstTs last=$lastTs\n";
|
||||
my $toolTimeSum = 0; $toolTimeSum += $_->{dur} for @durs;
|
||||
print "total tool time (sum all calls): ", $toolTimeSum/1000, "s\n";
|
||||
print "--- top 10 longest tool calls ---\n";
|
||||
for my $i (0..9) {
|
||||
last unless $durs[$i];
|
||||
my $d = $durs[$i];
|
||||
my $a = $d->{args}; $a =~ s/\s+/ /g; $a = substr($a,0,100);
|
||||
printf("%7.1fs %-8s %s %s\n", $d->{dur}/1000, $d->{name}, $a, ($d->{isError}?"ERROR":""));
|
||||
}
|
||||
print "--- errors ---\n";
|
||||
for my $d (@durs) {
|
||||
if ($d->{isError}) {
|
||||
my $a = $d->{args}; $a =~ s/\s+/ /g; $a = substr($a,0,100);
|
||||
my $e = $d->{err}; $e =~ s/\s+/ /g;
|
||||
print "$d->{name} $a :: $e\n";
|
||||
}
|
||||
}
|
||||
6
.archon/scripts/porneste_server.ps1
Normal file
6
.archon/scripts/porneste_server.ps1
Normal file
@@ -0,0 +1,6 @@
|
||||
# Porneste serverul web Archon (port 3090, publicat pe tailnet prin tailscale serve)
|
||||
foreach ($n in 'CLAUDE_USE_GLOBAL_AUTH','CLAUDE_BIN_PATH','ARCHON_TELEMETRY_DISABLED','OPENCODE_GO_API_KEY') {
|
||||
Set-Item "env:$n" ([Environment]::GetEnvironmentVariable($n, 'User'))
|
||||
}
|
||||
Set-Location D:\roa\roacont
|
||||
& "C:\Users\mmari\.archon\bin\archon.exe" serve
|
||||
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};
|
||||
}
|
||||
90
.archon/scripts/verifica_vfp_text.ps1
Normal file
90
.archon/scripts/verifica_vfp_text.ps1
Normal file
@@ -0,0 +1,90 @@
|
||||
<#
|
||||
Verificare mecanica dupa implement, pentru workflow-ul roa-fix (pilot Archon).
|
||||
Pentru fiecare fisier dat (implicit: git diff --name-only HEAD + fisiere noi netracked,
|
||||
in ProjectRoot):
|
||||
1. EF BF BD absent din tot fisierul (semnul coruperii cp1250/cp1252 -> UTF-8 replacement char).
|
||||
2. Zero LF izolat (CRLF pe tot fisierul) - conteaza octeti pe disc, nu string decodat.
|
||||
3. Pentru .vc2/.sc2: txt2vcx.ps1 -DryRun trebuie sa reuseasca (fidelity-check).
|
||||
Iesire: 0 daca toate fisierele trec toate verificarile; 1 la orice esec (cu motivul pe fisier).
|
||||
#>
|
||||
param(
|
||||
[string]$ProjectRoot = "D:\roa\roacont",
|
||||
[string[]]$Files
|
||||
)
|
||||
|
||||
$ErrorActionPreference = "Stop"
|
||||
Set-Location $ProjectRoot
|
||||
|
||||
if (-not $Files -or $Files.Count -eq 0) {
|
||||
$tracked = git diff --name-only HEAD 2>$null
|
||||
$untracked = git ls-files --others --exclude-standard 2>$null
|
||||
# COMUN e repo git separat, exclus din repo-ul proiectului
|
||||
$comun = @(git -C COMUN diff --name-only HEAD 2>$null) + @(git -C COMUN ls-files --others --exclude-standard 2>$null) | Where-Object { $_ } | Where-Object { $_ -match ".(prg|vc2|sc2|fr2|mn2|h)$" } | ForEach-Object { "COMUN/$_" }
|
||||
$Files = @($tracked) + @($untracked) + @($comun) | Where-Object { $_ -match ".(prg|vc2|sc2|fr2|mn2|h)$" } | Sort-Object -Unique
|
||||
}
|
||||
|
||||
if (-not $Files -or $Files.Count -eq 0) {
|
||||
Write-Output "Niciun fisier modificat - nimic de verificat."
|
||||
exit 0
|
||||
}
|
||||
|
||||
$failures = @()
|
||||
|
||||
foreach ($f in $Files) {
|
||||
$full = Join-Path $ProjectRoot $f
|
||||
if (-not (Test-Path $full)) {
|
||||
Write-Output "SKIP $f (sters sau inexistent)"
|
||||
continue
|
||||
}
|
||||
|
||||
$bytes = [IO.File]::ReadAllBytes($full)
|
||||
|
||||
# 1. EF BF BD absent
|
||||
$badSeq = 0
|
||||
for ($i = 0; $i -lt $bytes.Length - 2; $i++) {
|
||||
if ($bytes[$i] -eq 0xEF -and $bytes[$i+1] -eq 0xBF -and $bytes[$i+2] -eq 0xBD) { $badSeq++ }
|
||||
}
|
||||
if ($badSeq -gt 0) {
|
||||
$failures += "$f : $badSeq octet(i) EF BF BD (corupere cp1250/cp1252 -> UTF-8 replacement char)"
|
||||
continue
|
||||
}
|
||||
|
||||
# 2. CRLF pe tot fisierul (zero LF izolat)
|
||||
$lf = 0; $crlf = 0
|
||||
for ($i = 0; $i -lt $bytes.Length; $i++) {
|
||||
if ($bytes[$i] -eq 0x0A) {
|
||||
$lf++
|
||||
if ($i -gt 0 -and $bytes[$i-1] -eq 0x0D) { $crlf++ }
|
||||
}
|
||||
}
|
||||
$isolated = $lf - $crlf
|
||||
if ($isolated -ne 0) {
|
||||
$failures += "$f : $isolated LF izolat (fisierul nu mai e CRLF pe tot)"
|
||||
continue
|
||||
}
|
||||
|
||||
# 3. txt2vcx.ps1 -DryRun pentru .vc2/.sc2
|
||||
$ext = [IO.Path]::GetExtension($f).ToLowerInvariant()
|
||||
if ($ext -eq ".vc2" -or $ext -eq ".sc2") {
|
||||
# tintele de sub COMUN\ cer -AllowComun (DryRun nu scrie nimic)
|
||||
$argv = @('-ExecutionPolicy', 'Bypass', '-File', 'D:\ROA\UTIL\foxbin2prg\txt2vcx.ps1',
|
||||
'-TextFile', $full, '-ProjectRoot', $ProjectRoot, '-CacheRoot', $ProjectRoot, '-DryRun')
|
||||
if ($f -match '^COMUN[\\/]') { $argv += '-AllowComun' }
|
||||
& powershell $argv 2>&1 | Out-Null
|
||||
if ($LASTEXITCODE -ne 0) {
|
||||
$failures += "$f : txt2vcx.ps1 -DryRun a esuat (exit $LASTEXITCODE)"
|
||||
continue
|
||||
}
|
||||
}
|
||||
|
||||
Write-Output "OK $f"
|
||||
}
|
||||
|
||||
if ($failures.Count -gt 0) {
|
||||
Write-Output "--- ESECURI ---"
|
||||
$failures | ForEach-Object { Write-Output $_ }
|
||||
exit 1
|
||||
}
|
||||
|
||||
Write-Output "Toate fisierele au trecut verificarile."
|
||||
exit 0
|
||||
Reference in New Issue
Block a user