Acme-Claude-Shell

 view release on metacpan or  search on metacpan

lib/Acme/Claude/Shell/Hooks.pm  view on Meta::CPAN

        # PostToolUse: Stop spinner after command execution and track stats
        PostToolUse => [
            Claude::Agent::Hook::Matcher->new(
                matcher => $execute_cmd_pattern,
                hooks   => [sub {
                    my ($input, $tool_use_id, $context) = @_;
                    # Stop the execution spinner
                    if ($session->_spinner) {
                        stop_spinner($session->_spinner);
                        $session->_spinner(undef);
                    }
                    # Track tool usage
                    $session->{_tool_count}++;
                    return Claude::Agent::Hook::Result->proceed();
                }],
            ),
        ],

        # PostToolUseFailure: Handle tool failures gracefully
        PostToolUseFailure => [

lib/Acme/Claude/Shell/Query.pm  view on Meta::CPAN

            # when STDIN was used for hook confirmation
        }
        elsif ($msg->isa('Claude::Agent::Message::Result')) {
            $result = $msg;
            last;
        }
    }

    # Stop spinner
    stop_spinner($self->_spinner, "Done") if $self->_spinner;
    $self->_spinner(undef);

    # Show response
    if ($response_text) {
        print "\n", $response_text, "\n";
    }

    # Cleanup
    $iter->cleanup if $iter->can('cleanup');

    return $result;

lib/Acme/Claude/Shell/Session.pm  view on Meta::CPAN

on startup. Maximum 1000 lines are kept.

=cut

# Query cursor row position via /dev/tty (works even after Term::ReadLine)
# This avoids Term::ProgressSpinner's STDIN-based query which fails after readline
sub _get_cursor_row {
    my $row;
    eval {
        require Term::ReadKey;
        open(my $tty, '+<', '/dev/tty') or return undef;
        # Set raw mode on the tty
        Term::ReadKey::ReadMode(4, $tty);
        # Send cursor position query to STDOUT (terminal sees it)
        print STDOUT "\e[6n";
        STDOUT->flush();
        # Read response from the tty
        my $response = '';
        while (1) {
            my $c = Term::ReadKey::ReadKey(0.1, $tty);
            last unless defined $c;

lib/Acme/Claude/Shell/Session.pm  view on Meta::CPAN

    my $printed_response = 0;

    while (my $msg = await $self->_client->receive_async) {
        if ($msg->isa('Claude::Agent::Message::Assistant')) {
            # Print reasoning immediately so it appears BEFORE tool approval
            my $text = $msg->text // '';
            if ($text) {
                # Stop spinner before printing text
                if ($self->_spinner) {
                    stop_spinner($self->_spinner);
                    $self->_spinner(undef);
                }
                print "\n" unless $printed_response;
                my $output = $self->colorful ? colored(['white'], $text) : $text;
                print $output;
                $printed_response = 1;
            }
        }
        elsif ($msg->isa('Claude::Agent::Message::ToolUse')) {
            # Print newline after reasoning text before tool approval menu
            print "\n" if $printed_response;

lib/Acme/Claude/Shell/Session.pm  view on Meta::CPAN

            }
            # Don't restart spinner - avoids conflicts with Term::ProgressSpinner
            # when STDIN was used for hook confirmation
        }
        elsif ($msg->isa('Claude::Agent::Message::Result')) {
            last;
        }
    }

    stop_spinner($self->_spinner, "Done") if $self->_spinner;
    $self->_spinner(undef);

    # Final newline if we printed any response
    print "\n" if $printed_response;
}

sub _show_banner {
    my ($self) = @_;

    if ($self->colorful) {
        header("Acme::Claude::Shell");

lib/Acme/Claude/Shell/Tools.pm  view on Meta::CPAN

sub _execute_command {
    my ($session, $params, $loop) = @_;

    my $command = $params->{command};
    my $dir = $params->{working_dir} // $session->working_dir;
    my $colorful = $session->colorful;

    # Stop spinner before prompting for approval
    if ($session->can('_spinner') && $session->_spinner) {
        stop_spinner($session->_spinner);
        $session->_spinner(undef);
    }

    # Prompt for approval before executing
    my ($approved, $new_command) = _confirm_command($session, $command);

    unless ($approved) {
        my $future = $loop->new_future;
        $future->done(_mcp_result("User cancelled command", 1));
        return $future;
    }

lib/Acme/Claude/Shell/Tools.pm  view on Meta::CPAN

      reason  => 'Piping remote script to shell' },
);

sub _check_dangerous {
    my ($command) = @_;
    for my $check (@DANGEROUS_PATTERNS) {
        if ($command =~ $check->{pattern}) {
            return $check;
        }
    }
    return undef;
}

# Confirm command with user before executing
# Returns ($approved, $new_command) - $new_command is set if user edited it
sub _confirm_command {
    my ($session, $command) = @_;

    my $colorful = $session->colorful;

    # Check for dangerous patterns

lib/Acme/Claude/Shell/Tools.pm  view on Meta::CPAN

        { key => 'e', label => 'Edit command' },
        { key => 'x', label => 'Cancel' },
    ]) // 'x';

    if ($choice eq 'x') {
        if ($colorful) {
            status('warning', "Command cancelled");
        } else {
            print "Cancelled.\n";
        }
        return (0, undef);
    }
    elsif ($choice eq 'd') {
        if ($colorful) {
            status('info', "[DRY-RUN] Would execute:");
            print colored(['cyan'], "  $command\n\n");
        } else {
            print "[DRY-RUN] Would execute: $command\n";
        }
        return (0, undef);
    }
    elsif ($choice eq 'e') {
        my $new_cmd;
        if ($colorful) {
            $new_cmd = prompt("Edit command:", $command);
        } else {
            print "Edit command [$command]: ";
            $new_cmd = <STDIN>;
            chomp $new_cmd if defined $new_cmd;
            $new_cmd = $command unless length($new_cmd // '');

lib/Acme/Claude/Shell/Tools.pm  view on Meta::CPAN

        if (_check_dangerous($new_cmd) && $session->safe_mode) {
            my $confirmed;
            if ($colorful) {
                $confirmed = ask_yn("Are you SURE you want to run this command?", 'n');
            } else {
                print "Are you SURE? (y/N): ";
                my $ans = <STDIN>;
                chomp $ans if defined $ans;
                $confirmed = ($ans // '') =~ /^y/i;
            }
            return (0, undef) unless $confirmed;
        }

        return (1, $new_cmd);
    }

    # 'a' - Approve
    # For dangerous commands, require extra confirmation
    if ($danger && $session->safe_mode) {
        my $confirmed;
        if ($colorful) {

lib/Acme/Claude/Shell/Tools.pm  view on Meta::CPAN

            chomp $ans if defined $ans;
            $confirmed = ($ans // '') =~ /^y/i;
        }

        unless ($confirmed) {
            if ($colorful) {
                status('warning', "Command cancelled");
            } else {
                print "Cancelled.\n";
            }
            return (0, undef);
        }
    }

    return (1, undef);
}

sub _list_files {
    my ($session, $params, $loop) = @_;

    my $path = $params->{path} // '.';
    my $pattern = $params->{pattern} // '';
    my $long = $params->{long_format} // 1;
    my $hidden = $params->{hidden} // 0;

lib/Acme/Claude/Shell/Tools.pm  view on Meta::CPAN

    if ($path !~ m{^/}) {
        $full_path = File::Spec->catfile($session->working_dir // getcwd(), $path);
    }

    unless (-d $full_path) {
        $future->done(_mcp_result("Error: Not a directory: $path", 1));
        return $future;
    }

    my @results;
    my $regex = $pattern ? _glob_to_regex($pattern) : undef;
    my $content_re = $content ? qr/\Q$content\E/i : undef;

    _search_recursive($full_path, $full_path, $regex, $content_re, $max_depth, 0, \@results);

    if (@results) {
        $future->done(_mcp_result(join("\n", @results)));
    }
    else {
        $future->done(_mcp_result("No matches found"));
    }

t/01-tools.t  view on Meta::CPAN

# Create a mock session object for testing
package MockSession;
sub new {
    my ($class, %args) = @_;
    return bless {
        working_dir => $args{working_dir} // '.',
        colorful    => $args{colorful} // 0,
        safe_mode   => $args{safe_mode} // 1,
        _history    => [],
        _spinner    => undef,
    }, $class;
}
sub working_dir { $_[0]->{working_dir} }
sub colorful { $_[0]->{colorful} }
sub safe_mode { $_[0]->{safe_mode} }
sub _history { $_[0]->{_history} }
sub _spinner {
    my $self = shift;
    if (@_) { $self->{_spinner} = shift }
    return $self->{_spinner};

t/02-hooks.t  view on Meta::CPAN

package MockSession;
sub new {
    my ($class, %args) = @_;
    return bless {
        working_dir => $args{working_dir} // '.',
        colorful    => $args{colorful} // 0,
        safe_mode   => $args{safe_mode} // 1,
        verbose     => $args{verbose} // 0,
        audit_log   => $args{audit_log} // 0,
        _history    => [],
        _spinner    => undef,
    }, $class;
}
sub working_dir { $_[0]->{working_dir} }
sub colorful { $_[0]->{colorful} }
sub safe_mode { $_[0]->{safe_mode} }
sub _history { $_[0]->{_history} }
sub _spinner {
    my $self = shift;
    if (@_) { $self->{_spinner} = shift }
    return $self->{_spinner};

t/03-dangerous-patterns.t  view on Meta::CPAN

      reason  => 'Piping remote script to shell' },
);

sub check_dangerous {
    my ($command) = @_;
    for my $check (@DANGEROUS_PATTERNS) {
        if ($command =~ $check->{pattern}) {
            return $check;
        }
    }
    return undef;
}

# Test dangerous commands
subtest 'Dangerous rm commands' => sub {
    ok(check_dangerous('rm -rf /'), 'rm -rf detected');
    ok(check_dangerous('rm -r /tmp'), 'rm -r detected');
    ok(check_dangerous('rm -f file.txt'), 'rm -f detected');
    ok(check_dangerous('rm --recursive /home'), 'rm --recursive detected');
    ok(check_dangerous('rm --force file'), 'rm --force detected');
    ok(!check_dangerous('rm file.txt'), 'rm without flags is safe');

t/04-session.t  view on Meta::CPAN

subtest 'Session spinner' => sub {
    plan tests => 3;

    require IO::Async::Loop;
    my $loop = IO::Async::Loop->new;

    my $session = Acme::Claude::Shell::Session->new(
        loop => $loop,
    );

    ok(!$session->_spinner, 'Spinner starts undefined');

    $session->_spinner('fake-spinner');
    is($session->_spinner, 'fake-spinner', 'Can set spinner');

    $session->_spinner(undef);
    ok(!$session->_spinner, 'Can clear spinner');
};

done_testing();

t/05-query.t  view on Meta::CPAN

        working_dir => '/tmp',
        colorful    => 0,
    );

    ok($query, 'Query created');
    isa_ok($query, 'Acme::Claude::Shell::Query');
    is($query->dry_run, 0, 'dry_run attribute');
    is($query->safe_mode, 1, 'safe_mode attribute');
    is($query->working_dir, '/tmp', 'working_dir attribute');
    is($query->colorful, 0, 'colorful attribute');
    ok(!$query->_spinner, '_spinner starts undefined');
};

# Test optional model attribute
subtest 'Query with model' => sub {
    plan tests => 2;

    require IO::Async::Loop;
    my $loop = IO::Async::Loop->new;

    my $query = Acme::Claude::Shell::Query->new(

t/05-query.t  view on Meta::CPAN

subtest 'Query spinner' => sub {
    plan tests => 3;

    require IO::Async::Loop;
    my $loop = IO::Async::Loop->new;

    my $query = Acme::Claude::Shell::Query->new(
        loop => $loop,
    );

    ok(!$query->_spinner, 'Spinner starts undefined');

    $query->_spinner('fake-spinner');
    is($query->_spinner, 'fake-spinner', 'Can set spinner');

    $query->_spinner(undef);
    ok(!$query->_spinner, 'Can clear spinner');
};

done_testing();