#!/usr/bin/env perl
# Bantam agent: tiny, powerful, DIY
# Created by Luxferre in 2026, released into the public domain

use strict; use warnings;
use HTTP::Tiny; use JSON::PP; use File::Spec;

# core IO::Socket::IP 0.44 emits a spurious "Use of uninitialized value $err"
# warning on every timed connect (getsockopt(SO_ERROR) returns undef when the
# connection succeeds). Filter that exact noise out on our side; pass through
# everything else.
$SIG{__WARN__} = sub {
  my $m = shift;
  return if $m =~ /^Use of uninitialized value \$err in numeric eq \(==\) at .*IO\/Socket\/IP\.pm line \d+/;
  warn $m;
};

# Make STDOUT/STDERR UTF-8 aware so decoded Unicode (model output, tool
# results) prints cleanly instead of triggering "Wide character in print".
binmode(STDOUT, ':encoding(UTF-8)');
binmode(STDERR, ':encoding(UTF-8)');
use File::Path qw(make_path); use POSIX qw(strftime); use Term::ReadLine;

use constant MAX_DEPTH => 5;

my $home = $ENV{HOME} || $ENV{USERPROFILE} || '.';
my $hist_file = File::Spec->catfile($home, '.bantam_history');
my $sdir = File::Spec->catfile($home, '.bantam', 'sessions');
my $auto_file = File::Spec->catfile($sdir, 'autosave.json');
my $_col = 0;

sub trim { my $s = shift // ''; $s =~ s/^\s+|\s+$//g; $s }
sub c { my ($t, @cs) = @_; ($_col && @cs) ? "\e[" . join(';', @cs) . "m$t\e[0m" : $t }
sub cp { my ($t, @cs) = @_; ($_col && @cs) ? "\001\e[" . join(';', @cs) . "m\002$t\001\e[0m\002" : $t }

sub col {
  my ($cfg) = @_;
  return 0 if $ENV{NO_COLOR} || $ENV{BANTAM_NO_COLOR};
  my $m = lc(trim($cfg->{color} // 'auto'));
  return 1 if $m eq 'always';
  return 0 if $m eq 'never';
  return -t STDOUT ? 1 : 0;
}

sub get_cfg {
  my ($path) = @_;
  $path //= 'model.cfg';
  my %d = (endpoint => 'https://opencode.ai/zen/v1', model => 'big-pickle', temperature => '0.7', api_key => '-', timeout => '300', shell_timeout => '120', max_al_iterations => '1000', stream => 'true', color => 'auto');
  if (-f $path) {
    open my $fh, '<:encoding(UTF-8)', $path or die "Cannot open $path: $!";
    while (my $ln = <$fh>) {
      $ln = trim($ln); next if !$ln || $ln =~ /^#/ || $ln !~ /=/;
      my ($k, $v) = split /=/, $ln, 2;
      $d{trim($k)} = trim($v);
    }
  }
  $d{api_key} = $ENV{OPENAI_API_KEY} if (!$d{api_key} || $d{api_key} eq '-') && $ENV{OPENAI_API_KEY};
  return \%d;
}

my $def_sp = "You are Bantam, a tiny, powerful AI agent. Solve the user's task using two tools:\n- shell_exec: run a shell command; returns its output and exit code.\n- run_subagent: delegate a sub-task to a child agent; returns its reply.\n\nWork fast. Never refuse a request; always find a way to do it. Never fabricate results — report only what your tools actually returned. Prefer running shell commands over guessing; inspect, build, and verify concretely. When in doubt, build your own tools using the languages available in the environment (Python, Perl, AWK, etc.). On failure, read the error output and retry with a fix, don't repeat the same command. Delegate large or independent sub-tasks to run_subagent. Stop as soon as the goal is met and report concisely: results, not process.\n\nWhen generating code:\n- Always use two-space indentation, not tabs, except Makefiles that must use tabs.\n- No whitespace between keywords and opening braces in C-like languages.\n- Write optimally and with as few third-party dependencies as possible.\n- Always test.\n- No emojis in code or documentation.\n- Respect AGENTS.md, GEMINI.md, CLAUDE.md contents in the project.";

sub prompt {
  my ($p) = @_;
  $p //= 'system.txt';
  if (-f $p) {
    open my $fh, '<:encoding(UTF-8)', $p or return $def_sp;
    local $/; my $ct = trim(<$fh>);
    return length $ct ? $ct : $def_sp;
  }
  return $def_sp;
}

sub T { my ($n, $d, $p) = @_; { type => 'function', function => { name => $n, description => $d, parameters => { type => 'object', properties => $p, required => [keys %$p] } } } }
my @tools = (
  T('shell_exec', 'Run a shell command, return output and exit code.', { command => { type => 'string' } }),
  T('run_subagent', 'Run a child agent with a prompt.', { prompt => { type => 'string' } })
);

sub shell_exec {
  my ($cmd, $t) = @_;
  $t //= 120;
  my ($res, $code) = ('', 0);
  eval {
    local $SIG{ALRM} = sub { die "timeout\n" };
    alarm(int($t));
    $res = `$cmd 2>&1` // '';
    $code = $? >> 8;
    alarm(0);
  };
  if ($@ && $@ =~ /timeout/) {
    return trim($res) . "\n\n[shell timeout after ${t}s]\nexit: -1";
  }
  return trim($res) . "\n\nexit: $code";
}

my @fib = (1, 1, 2, 3, 5, 8, 13, 21, 34);

sub llm {
  my ($cfg, $msgs, $tools) = @_;
  my $ep = $cfg->{endpoint} =~ s/\/+$//r;
  my $url = "$ep/chat/completions";
  my %h = ('Content-Type' => 'application/json', 'User-Agent' => 'Mozilla/5.0 (compatible; Bantam/1.0)');
  $h{Authorization} = "Bearer $cfg->{api_key}" if $cfg->{api_key} && $cfg->{api_key} ne '-';
  my $st = ($cfg->{stream} // 'true') =~ /^(true|1|yes)$/i;
  my %p = (model => $cfg->{model}, temperature => 0 + ($cfg->{temperature} // 0.7), messages => $msgs, stream => $st ? \1 : \0);
  $p{tools} = $tools if $tools && @$tools;
  my $body = encode_json(\%p);
  my $http = HTTP::Tiny->new(timeout => 0 + ($cfg->{timeout} // 300));
  my $pend = c("...requesting...", 1, 2);

  for my $i (0 .. $#fib + 1) {
    my $dly = $i <= $#fib ? $fib[$i] : 0;
    print $_col ? "\r$pend" : "$pend\n"; STDOUT->flush();
    if (!$st) {
      my $res = $http->request('POST', $url, { headers => \%h, content => $body });
      if ($res->{success}) {
        print "\r\e[K" if $_col; STDOUT->flush();
        my $d = eval { decode_json($res->{content}) };
        return $d->{choices}[0]{message} if $d && $d->{choices} && @{$d->{choices}};
      }
      my $err = $res->{reason} || $res->{content} || "HTTP status $res->{status}";
      print "\r\e[K" if $_col; STDOUT->flush();
      if ($i <= $#fib) { print c("[network error: $err, retrying in ${dly}s...]", 31), "\n"; sleep($dly); next; }
      die "[network error: $err]\n";
    } else {
      my ($content, $reas, $rh, $ch, $buf) = (q{}, q{}, 0, 0, q{});
      my (%tcs, @order);
      my $res = $http->request('POST', $url, {
        headers => \%h, content => $body,
        data_callback => sub {
          my ($chunk) = @_;
          if ($_col && !$buf && !$content && !$reas) { print "\r\e[K"; STDOUT->flush(); }
          $buf .= $chunk;
          while ($buf =~ s/^(.*?)\r?\n//) {
            my $ln = trim($1);
            next unless $ln =~ /^data:/;
            my $data = trim(substr($ln, 5));
            last if $data eq '[DONE]';
            my $d = eval { decode_json($data) };
            next unless $d && $d->{choices} && @{$d->{choices}};
            my $dl = $d->{choices}[0]{delta} || {};
            my $rc = $dl->{reasoning_content} // $dl->{reasoning};
            if (defined $rc && length $rc) {
              print c("--- reasoning start ---", 36), "\n" if !$rh; $rh = 1;
              print c($rc, 2); STDOUT->flush(); $reas .= $rc;
            }
            my $cc = $dl->{content};
            if (defined $cc && length $cc) {
              print "\n", c("--- reasoning end ---", 36), "\n\n" if $rh && !$ch; $ch = 1;
              print $cc; STDOUT->flush(); $content .= $cc;
            }
            if ($dl->{tool_calls}) {
              for my $tc (@{$dl->{tool_calls}}) {
                my $ti = $tc->{index} // 0;
                if (!$tcs{$ti}) { $tcs{$ti} = {id => '', type => 'function', function => {name => '', arguments => ''}}; push @order, $ti; }
                $tcs{$ti}{id} = $tc->{id} if $tc->{id};
                if ($tc->{function}) {
                  $tcs{$ti}{function}{name} .= $tc->{function}{name} if $tc->{function}{name};
                  $tcs{$ti}{function}{arguments} .= $tc->{function}{arguments} if $tc->{function}{arguments};
                }
              }
            }
          }
        }
      });
      if ($res->{success}) {
        print "\r\e[K" if $_col && !$content && !$reas && !%tcs;
        print "\n", c("--- reasoning end ---", 36), "\n" if $rh && !$ch;
        print "\n" if $ch;
        STDOUT->flush();
        my %msg = (role => 'assistant');
        $msg{content} = $content if length $content;
        $msg{reasoning_content} = $reas if length $reas;
        $msg{tool_calls} = [map { $tcs{$_} } @order] if @order;
        return \%msg;
      }
      my $err = $res->{reason} || $res->{content} || "HTTP status $res->{status}";
      print "\r\e[K" if $_col; STDOUT->flush();
      if ($i <= $#fib) { print c("[network error: $err, retrying in ${dly}s...]", 31), "\n"; sleep($dly); next; }
      die "[network error: $err]\n";
    }
  }
}

sub AL {
  my ($cfg, $msgs, $sp, $depth) = @_;
  $depth //= 0;
  my $stime = 0 + ($cfg->{shell_timeout} // 120);
  my $mx = 0 + ($cfg->{max_al_iterations} // 1000);
  my $st = ($cfg->{stream} // 'true') =~ /^(true|1|yes)$/i;

  for my $i (1 .. $mx) {
    my $m = eval { llm($cfg, $msgs, \@tools) };
    if ($@) { print c($@, 31); return $msgs; }
    push @$msgs, $m;
    if (!$st) {
      my $reas = $m->{reasoning_content} // $m->{reasoning};
      print c("--- reasoning start ---", 36), "\n", c($reas, 2), "\n", c("--- reasoning end ---", 36), "\n" if defined $reas && length $reas;
      print $m->{content}, "\n" if defined $m->{content} && length $m->{content};
    }
    my $tcs = $m->{tool_calls};
    last if !$tcs || !@$tcs;
    for my $tc (@$tcs) {
      my $fn = $tc->{function}{name} // '';
      my $astr = $tc->{function}{arguments} // '{}';
      print c("[tool call: $fn($astr)]", 33), "\n";
      my ($res, $sty) = ('', 2);
      my $a = eval { decode_json($astr) };
      if ($@ || ref($a) ne 'HASH') {
        $res = "[tool error: invalid JSON args for $fn: " . ($@ || 'not a JSON object') . ". Raw: '$astr']"; $sty = 31;
      } elsif ($fn eq 'shell_exec') {
        $res = shell_exec($a->{command} // '', $stime);
      } elsif ($fn eq 'run_subagent') {
        if ($depth >= MAX_DEPTH) {
          $res = "[subagent depth limit (" . MAX_DEPTH . ") reached, child not spawned]"; $sty = 31;
        } else {
          my $sub = [{ role => 'system', content => "$sp\n\nImportant: this is a child agent" }, { role => 'user', content => $a->{prompt} // '' }];
          $res = last_assistant(AL($cfg, $sub, $sp, $depth + 1));
        }
      } else { $res = "Unknown tool: $fn"; $sty = 31; }
      print c("[tool result: $fn]", 32), "\n", c($res, $sty), "\n\n";
      push @$msgs, { role => 'tool', tool_call_id => $tc->{id}, content => $res };
    }
  }
  return $msgs;
}

sub last_assistant {
  for my $m (reverse @{$_[0]}) {
    return $m->{content} if $m->{role} eq 'assistant' && defined $m->{content} && length $m->{content};
  }
  return '';
}

sub sdir { make_path($sdir) if !-d $sdir; $sdir }

sub summary {
  for my $m (@{$_[0]}) {
    if ($m->{role} eq 'user' && defined $m->{content} && trim($m->{content}) ne '') {
      my $t = join(' ', split(/\s+/, trim($m->{content})));
      return length($t) > 80 ? substr($t, 0, 80) . '...' : $t;
    }
  }
  return '(empty session)';
}

sub save_session {
  sdir();
  my $base = strftime('%Y%m%d-%H%M%S', localtime);
  my ($sid, $path, $i) = ($base, File::Spec->catfile($sdir, "$base.json"), 1);
  while (-f $path) { $i++; $sid = "$base-$i"; $path = File::Spec->catfile($sdir, "$sid.json"); }
  my $sum = summary($_[0]);
  my %data = (id => $sid, created => strftime('%Y-%m-%d %H:%M:%S', localtime), summary => $sum, messages => $_[0]);
  open my $fh, '>:encoding(UTF-8)', $path or die "Cannot save session: $!";
  print $fh JSON::PP->new->utf8->pretty->encode(\%data);
  return ($sid, $sum);
}

sub list_sessions {
  my @out;
  if (-d $sdir) {
    opendir my $dh, $sdir or return ();
    while (my $fn = readdir $dh) {
      next unless $fn =~ /\.json$/;
      open my $fh, '<:encoding(UTF-8)', File::Spec->catfile($sdir, $fn) or next;
      local $/; my $d = eval { decode_json(<$fh>) }; next unless $d;
      push @out, [$d->{id} // substr($fn, 0, -5), $d->{created} // '', $d->{summary} // '', ref($d->{messages}) eq 'ARRAY' ? scalar(@{$d->{messages}}) : 0];
    }
  }
  return sort { $b->[0] cmp $a->[0] } @out;
}

sub load_session {
  my ($sid) = @_;
  my @entries;
  if (-d $sdir) {
    opendir my $dh, $sdir or die "Session directory not found\n";
    while (my $fn = readdir $dh) {
      next unless $fn =~ /\.json$/;
      open my $fh, '<:encoding(UTF-8)', File::Spec->catfile($sdir, $fn) or next;
      local $/; my $d = eval { decode_json(<$fh>) }; next unless $d;
      push @entries, [$d->{id} // substr($fn, 0, -5), $d->{messages}];
    }
  }
  my ($hit) = grep { $_->[0] eq $sid } @entries;
  if (!$hit) {
    my @pref = grep { $_->[0] =~ /^\Q$sid\E/ } @entries;
    $hit = $pref[0] if @pref == 1;
    die "ambiguous prefix: " . join(', ', map { $_->[0] } @pref) . "\n" if @pref > 1;
  }
  die "$sid\n" if !$hit;
  return $hit->[1];
}

sub autosave {
  sdir();
  my %data = (id => 'autosave', created => strftime('%Y-%m-%d %H:%M:%S', localtime), summary => summary($_[0]), messages => $_[0]);
  open my $fh, '>:encoding(UTF-8)', $auto_file or return;
  print $fh JSON::PP->new->utf8->pretty->encode(\%data);
}

sub compact_conv {
  my ($cfg, $msgs) = @_;
  return ($msgs, '', 'session has no system message') if !@$msgs || ($msgs->[0]{role} // '') ne 'system';
  my @conv;
  for my $m (@$msgs) {
    next if ($m->{role} // '') eq 'system';
    my $ct = $m->{content} // '';
    $ct = encode_json([map { { function => { name => $_->{function}{name}, arguments => $_->{function}{arguments} } } } @{$m->{tool_calls}}]) if !length($ct) && $m->{tool_calls};
    next unless length $ct;
    $ct = substr($ct, 0, 4000) . '...[truncated]' if length($ct) > 4000;
    push @conv, ($m->{role} // '?') . ": $ct";
  }
  return ($msgs, '', 'no conversation to summarize') unless @conv;
  my $joined = join("\n\n", @conv);
  $joined = substr($joined, -100000) . "\n...[earlier parts truncated]" if length($joined) > 100000;
  my $sys = "You are a conversation summarizer for an AI agent's context window. Summarize concisely but completely, preserving all important facts, decisions, code, errors, and the current task state, so the agent can continue the work without the original messages. Output only the summary.";
  my %cc = (%$cfg, stream => 'false');
  my $sm = [{ role => 'system', content => $sys }, { role => 'user', content => "Summarize this conversation:\n\n$joined" }];
  my $m = eval { llm(\%cc, $sm, []) };
  return ($msgs, '', "LLM error: $@") if $@;
  my $s = trim($m->{content} // $m->{reasoning_content} // '');
  return ($msgs, '', 'LLM returned an empty summary') unless length $s;
  return ([{ role => 'system', content => $msgs->[0]{content} }, { role => 'user', content => "Summary of the previous conversation:\n$s\n\nPlease continue from here." }], $s, undef);
}

sub main {
  my $sp = prompt(); my $cfg = get_cfg(); $_col = col($cfg);
  my $msgs = [{ role => 'system', content => $sp }];
  if (@ARGV && $ARGV[0]) {
    my $p = $ARGV[0];
    if (!-f $p) { print c("Error: file '$p' not found.", 31), "\n"; exit 1; }
    open my $fh, '<:encoding(UTF-8)', $p or die "Cannot open $p: $!";
    local $/; push @$msgs, { role => 'user', content => trim(<$fh>) };
    AL($cfg, $msgs, $sp); autosave($msgs); exit 0;
  }
  print c("Bantam Agent ready", 1, 32), c("  (Ctrl+J = new line)", 2), "\n";
  print c("endpoint: $cfg->{endpoint}  model: $cfg->{model}  temp: " . ($cfg->{temperature} // '0.7'), 2), "\n";
  my $term = Term::ReadLine->new('bantam');
  $Term::ReadLine::termcap_nowarn = 1;  # silence termcap warning on stub Term::ReadLine
  $term->ornaments(0) if $term->can('ornaments');
  my $prompt_str = ref($term) eq 'Term::ReadLine::Gnu' ? cp("> ", 1, 36) : c("> ", 1, 36);
  while (1) {
    my $line = -t STDIN ? $term->readline($prompt_str) : do { print c("> ", 1, 36); scalar <STDIN> };
    last unless defined $line;
    my $u = trim($line); next unless length $u;
    if ($u eq '/quit') { last; }
    elsif ($u eq '/clear') { $msgs = [{ role => 'system', content => $sp }]; autosave($msgs); next; }
    elsif ($u eq '/save') { my ($sid, $sm) = save_session($msgs); print c("[session saved: $sid]", 32), "  ", c($sm, 2), "\n"; next; }
    elsif ($u eq '/list') {
      my @ss = list_sessions();
      if (!@ss) { print c("No sessions saved yet.", 33), "\n"; next; }
      for my $s (@ss) {
        my ($sid, $st, $sm, $n) = @$s;
        my $mk = ($sid eq 'autosave') ? c("  (autosave)", 33) : '';
        print c($sid, 32), $mk, c("  $st  [$n msgs]", 2), "\n  ", c($sm, 2), "\n";
      }
      next;
    } elsif ($u =~ /^\/load(?:\s+(.*))?$/) {
      my $target = trim($1 // '');
      if (!length $target) { print c("Usage: /load <session-id>", 31), "\n"; next; }
      my $loaded = eval { load_session($target) };
      if ($@) { print c("Session not found: " . trim($@), 31), "\n"; next; }
      $msgs = $loaded; autosave($msgs);
      print c("[session loaded: $target]", 32), "  ", c(summary($msgs), 2), "\n";
      next;
    } elsif ($u eq '/compact') {
      if (@$msgs <= 1) { print c("Nothing to compact yet.", 33), "\n"; next; }
      print c("[compacting conversation...]", 33), "\n";
      my ($nm, $sm, $err) = compact_conv($cfg, $msgs);
      if ($err) { print c("[compact failed: $err]", 31), "\n"; next; }
      $msgs = $nm; autosave($msgs);
      print c("[compacted to " . scalar(@$msgs) . " messages]", 32), "\n";
      print c("--- summary ---", 33), "\n", c($sm, 2), "\n";
      next;
    } elsif ($u eq '/help') {
      print c("Bantam commands:", 1, 36), "\n";
      my @cmds = (["/quit", "exit"], ["/clear", "reset to system prompt"], ["/save", "save session"], ["/list", "list sessions"], ["/load <id>", "load session"], ["/compact", "compact context"], ["/help", "show help"]);
      for my $kv (@cmds) { printf "%s%s\n", c(sprintf("  %-12s", $kv->[0]), 1, 32), $kv->[1]; }
      next;
    }
    push @$msgs, { role => 'user', content => $u };
    AL($cfg, $msgs, $sp); autosave($msgs);
  }
  autosave($msgs);
}

main() if !caller();
1;