view release on metacpan or  search on metacpan

lib/Claude/Agent/Query.pm  view on Meta::CPAN

            $buffer_threshold, $min_threshold, $min_threshold));
        $buffer_threshold = $min_threshold;
    }
    elsif ($buffer_threshold > $max_threshold) {
        $log->debug(sprintf("CLAUDE_AGENT_JSONL_BUFFER_MAX=%d exceeds maximum (%d), using %d",
            $buffer_threshold, $max_threshold, $max_threshold));
        $buffer_threshold = $max_threshold;
    }

    # Check buffer size regardless of decode success to prevent unbounded growth
    if ($self->_jsonl->remaining && length($self->_jsonl->remaining) > $buffer_threshold) {
        $log->debug(sprintf("JSON::Lines buffer overflow detected (size: %d, threshold: %d), reinitializing",
            length($self->_jsonl->remaining), $buffer_threshold));
        $self->_jsonl(JSON::Lines->new(
            utf8     => 1,
            error_cb => sub {
                my ($action, $error, $data) = @_;
                $log->trace(sprintf("JSON::Lines %s error: %s", $action, $error));
                return;
            },
        ));
    }

    return unless @decoded;

    for my $data (@decoded) {
        if ($log->is_trace) {
            $log->trace(sprintf("Decoded item ref type: %s", ref($data) // "not a ref"));
            if (ref $data eq 'HASH') {
                $log->trace(sprintf("Hash keys: %s", join(", ", keys %$data)));
            }
        }
        next unless defined $data && ref $data eq 'HASH';
        $log->trace(sprintf("Message type in data: %s", $data->{type} // "undef"))
            if $log->is_trace;
        next unless exists $data->{type};  # Skip malformed/partial JSON data

        $log->debug(sprintf("Query: Received message type=%s", $data->{type}));

        my $msg = Claude::Agent::Message->from_json($data);

        # Log message subtype for more detail
        if ($msg->can('subtype') && $msg->subtype) {
            $log->debug(sprintf("Query: Message subtype=%s", $msg->subtype));
        }

        # Capture session_id from init message
        if ($msg->isa('Claude::Agent::Message::System')
            && $msg->subtype eq 'init') {
            $self->_session_id($msg->get_session_id);
            $log->debug(sprintf("Query: Session ID captured: %s", $self->_session_id // 'none'));
            # Update hook executor with session_id
            if ($self->_hook_executor) {
                $self->_hook_executor->session_id($self->_session_id);
            }
        }

        # Execute Perl hooks for tool use messages
        $msg = $self->_execute_hooks_for_message($msg);

        # Skip if message was blocked by hooks
        if (!defined $msg) {
            $log->debug(sprintf("Query: Message type=%s blocked by hooks", $data->{type}));
            next;
        }

        # Re-entrancy guard: if already processing, queue for later
        if ($self->_processing_message) {
            push @{$self->_messages}, $msg;
            next;
        }
        $self->_processing_message(1);

        if (@{$self->_pending_futures}) {
            my $future = shift @{$self->_pending_futures};
            $log->debug(sprintf("Query: Delivering message type=%s to waiting future", $data->{type}));
            $future->done($msg);
        }
        else {
            $log->debug(sprintf("Query: Queuing message type=%s (queue size=%d)", $data->{type}, scalar(@{$self->_messages}) + 1));
            push @{$self->_messages}, $msg;
        }

        $self->_processing_message(0);
    }
    return;
}

# Execute hooks for messages containing tool use/result blocks
# PreToolUse hooks are awaited (blocking), PostToolUse hooks are fire-and-forget
sub _execute_hooks_for_message {
    my ($self, $msg) = @_;

    return $msg unless $self->_hook_executor;

    # Handle assistant messages with tool_use blocks (PreToolUse)
    if ($msg->isa('Claude::Agent::Message::Assistant')) {
        my $tool_uses = $msg->tool_uses;
        if ($tool_uses && @$tool_uses) {
            $log->debug(sprintf("Query: Processing %d tool_use block(s)", scalar(@$tool_uses)));
            for my $tool_use (@$tool_uses) {
                my $tool_name = $tool_use->can('name') ? $tool_use->name : $tool_use->{name};
                my $tool_input = $tool_use->can('input') ? $tool_use->input : $tool_use->{input};
                my $tool_use_id = $tool_use->can('id') ? $tool_use->id : $tool_use->{id};

                next unless $tool_name && $tool_use_id;

                $log->trace(sprintf("Query: Tool use: name=%s id=%s", $tool_name, $tool_use_id));

                # Track this tool use for PostToolUse hooks
                $self->_pending_tool_uses->{$tool_use_id} = {
                    tool_name  => $tool_name,
                    tool_input => $tool_input,
                };

                # Run PreToolUse hooks (must await result for decision)
                if ($self->_hook_executor->has_hooks_for('PreToolUse')) {
                    my $result_future = $self->_hook_executor->run_pre_tool_use(
                        $tool_name, $tool_input, $tool_use_id
                    );

                    # Await the Future - hooks may be async
                    my $result = $self->_await_hook_result($result_future);

                    if ($result->{decision} eq 'deny') {
                        $log->info(sprintf("[HOOK] Blocked tool: %s - %s",
                            $tool_name, $result->{reason} // 'denied by hook'));

                        # Send permission denial to CLI
                        $self->respond_to_permission($tool_use_id, {
                            behavior => 'deny',
                            reason   => $result->{reason} // 'Denied by Perl hook',
                        });

                        # Remove from pending since we denied it
                        delete $self->_pending_tool_uses->{$tool_use_id};
                    }
                    elsif ($result->{decision} eq 'allow' && $result->{updated_input}) {
                        $log->debug(sprintf("[HOOK] Modified tool input for: %s", $tool_name));

                        # Send permission with modified input
                        $self->respond_to_permission($tool_use_id, {
                            behavior      => 'allow',
                            updated_input => $result->{updated_input},
                        });

                        # Update pending with modified input
                        $self->_pending_tool_uses->{$tool_use_id}{tool_input} =
                            $result->{updated_input};
                    }
                    # 'continue' or 'allow' without modifications - let it proceed normally
                }
            }
        }
    }

    # Handle system messages with tool results (PostToolUse / PostToolUseFailure)
    if ($msg->isa('Claude::Agent::Message::System')) {
        my $subtype = $msg->subtype // '';

        # Check for tool result in system message
        if ($subtype eq 'tool_result' || $subtype eq 'tool_output') {
            my $tool_use_id = $msg->can('tool_use_id') ? $msg->tool_use_id : undef;

            if ($tool_use_id && exists $self->_pending_tool_uses->{$tool_use_id}) {
                my $pending = delete $self->_pending_tool_uses->{$tool_use_id};
                my $tool_name = $pending->{tool_name};
                my $tool_input = $pending->{tool_input};

                # Determine if success or failure
                my $is_error = $msg->can('is_error') ? $msg->is_error : 0;
                $log->debug(sprintf("Query: Tool result received: name=%s id=%s %s",
                    $tool_name, $tool_use_id, $is_error ? '(error)' : '(success)'));
                my $tool_result = $msg->can('content') ? $msg->content : undef;

                if ($is_error) {
                    if ($self->_hook_executor->has_hooks_for('PostToolUseFailure')) {
                        # Fire and forget - don't block on PostToolUseFailure
                        my $future = $self->_hook_executor->run_post_tool_use_failure(
                            $tool_name, $tool_input, $tool_use_id, $tool_result
                        );
                        $self->_retain_hook_future($future);
                    }
                }
                else {
                    if ($self->_hook_executor->has_hooks_for('PostToolUse')) {