view release on metacpan or  search on metacpan

lib/App/Greple/xlate/llm.pm  view on Meta::CPAN

        sub {
            if    (@before > 1) { pop @before; 1 }
            elsif (@after  > 1) { pop @after;  1 }
            else  { 0 }
        },
        sub {
            if (length($sb) > $CONTEXT_SOURCE_MIN) {
                $sb = substr($sb, -$CONTEXT_SOURCE_MIN);
                $sb =~ s/\A[^\n]*\n//;
                return 1;
            }
            if (length($sa) > $CONTEXT_SOURCE_MIN) {
                $sa = substr($sa, 0, $CONTEXT_SOURCE_MIN);
                $sa =~ s/(?<=\n)[^\n]*\z//;
                return 1;
            }
            0;
        },
        sub {
            if    (@before) { pop @before; 1 }
            elsif (@after)  { pop @after;  1 }
            else  { 0 }
        },
        sub { $show_change ? do { $show_change = 0; 1 } : 0 },
        sub { @old ? do { pop @old; 1 } : 0 },
    );
    my $data = $render->();
    STEP: for my $step (@trim) {
        while (length($json_flat->encode($data)) > $CONTEXT_MAX) {
            $step->() or next STEP;
            $data = $render->();
        }
        last;
    }
    $data;
}

sub build_request {
    my $input = shift;
    my $request = { input => $input };
    if (my $context = context_payload()) {
        $request->{context} = $context if %$context;
    }
    $request;
}

sub llm_command {
    my($param, $system) = @_;
    my @command = ('llm', '-m' => $param->{model}, '-s' => $system);
    for my $kv (@{$param->{options} // []}) {
        push @command, '-o', @$kv;
    }
    push @command, '--no-stream', '--no-log';
    @command;
}

sub _llm_in_path {
    grep { -x "$_/llm" } split /:/, $ENV{PATH} // '';
}

sub _not_found {
    "llm: command not found.\n" .
    "Install llm <https://llm.datasette.io/> with " .
    "\"pip install llm\" or \"pipx install llm\".\n";
}

sub run_llm {
    state $run = Command::Run->new;
    my($param, $text) = @_;
    ##
    ## Check PATH before forking: Command::Run's forked child has no
    ## exit guard after a failed exec, so reaching that path would let
    ## the child escape into the caller's code.
    ##
    _llm_in_path() or die _not_found();
    my @command = llm_command($param, build_system($param));
    warn Dumper \@command if opt('debug');
    my $result = $run->command(@command)
                     ->run(stdin => $text, stderr => 'capture');
    if ($result->{result} != 0) {
        die diagnose($param, $result);
    }
    print STDERR $result->{error} if $result->{error};
    $result->{data};
}

##
## Called when the llm command fails: figure out why and return a
## message useful to the user.
##
sub diagnose {
    my($param, $result) = @_;
    my $stderr = $result->{error} // '';
    if (! _llm_in_path()) {
        return _not_found();
    }
    my $model = $param->{model};
    my $models = Command::Run->new->command('llm', 'models')
        ->run(stderr => 'capture')->{data} // '';
    if ($models !~ /\Q$model\E/) {
        return "llm does not know model \"$model\".\n" .
               "Upgrade llm (\"pip install -U llm\") or register the model " .
               "in extra-openai-models.yaml.\n" .
               ($stderr ? "\n$stderr" : "");
    }
    return "llm failed:\n$stderr";
}

sub xlate_each {
    my $param = shift;
    my @count = map { int tr/\n/\n/ } @_;
    _progress("From:\n", map s/^/\t< /mgr, @_);
    my @in = map { m/.*\n/mg } @_;
    my $out = run_llm($param, $json->encode(build_request(\@in)));
    my $obj = eval { $json->decode($out) };
    ref $obj eq 'ARRAY'
        or die "Invalid JSON response:\n\n$out\n";
    if (@$obj != @in) {
        die sprintf("Unexpected response element count (%d != %d):\n\n%s\n",
                    scalar(@$obj), scalar(@in), $out);
    }
    for my $i (0 .. $#$obj) {
        defined($obj->[$i]) && !ref($obj->[$i])
            && $json_flat->encode($obj->[$i]) =~ /\A"/
            or die sprintf("Invalid response element %d (expected string):\n\n%s\n",
                           $i, $out);
    }
    my @out = map { s/(?<!\n)\z/\n/r } @$obj;
    _progress("To:\n", map s/^/\t> /mgr, @out);
    map { join '', splice @out, 0, $_ } @count;
}

##
## Public entry point for engine modules: batch the blocks up to the
## maxlen/maxline limits and translate each batch in one llm call.
##
sub xlate_with {
    my $param = shift;
    my @from = map { /\n\z/ ? $_ : "$_\n" } @_;
    my @to;
    my $max = $App::Greple::xlate::max_length || $param->{max} // die;
    my $maxline = $App::Greple::xlate::max_line;
    if (my @len = grep { $_ > $max } map length, @from) {
        die "Contain lines longer than max length (@len > $max).\n";
    }
    while (@from) {
        my @tmp;
        my $len = 0;
        while (@from) {
            my $next = length $from[0];
            last if $len + $next > $max;
            $len += $next;
            push @tmp, shift @from;
            last if $maxline > 0 and @tmp >= $maxline;
        }