view release on metacpan or  search on metacpan

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

    my ($session, $command) = @_;

    my $colorful = $session->colorful;

    # Check for dangerous patterns
    my $danger = _check_dangerous($command);

    print "\n";

    if ($danger && $session->safe_mode) {
        if ($colorful) {
            status('warning', "Potentially dangerous command detected!");
            print colored(['yellow'], "  Reason: $danger->{reason}\n");
        } else {
            print "WARNING: Potentially dangerous command!\n";
            print "  Reason: $danger->{reason}\n";
        }
        print "\n";
    }

    # Show the command
    if ($colorful) {
        status('info', "Command: $command");
    } else {
        print "Command: $command\n";
    }

    # Show action menu
    my $choice = menu("Action", [
        { key => 'a', label => 'Approve and run' },
        { key => 'd', label => 'Dry-run (preview only)' },
        { 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 // '');
        }

        if ($colorful) {
            status('info', "Modified command:");
            print colored(['bold', 'white'], "  $new_cmd\n\n");
        } else {
            print "Modified: $new_cmd\n";
        }

        # For dangerous commands after editing, still require confirmation
        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) {
            $confirmed = ask_yn("Are you SURE you want to run this dangerous command?", 'n');
        } else {
            print "Are you SURE? (y/N): ";
            my $ans = <STDIN>;
            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

    # Resolve path
    my $full_path = $path;
    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"));
    }

    return $future;
}

sub _search_recursive {
    my ($base, $dir, $name_re, $content_re, $max_depth, $depth, $results) = @_;

    return if defined $max_depth && $depth > $max_depth;
    return if @$results >= 100;  # Limit results

    opendir my $dh, $dir or return;
    my @entries = readdir($dh);
    closedir $dh;

    for my $entry (sort @entries) {
        next if $entry eq '.' || $entry eq '..';

        my $path = File::Spec->catfile($dir, $entry);
        my $rel_path = File::Spec->abs2rel($path, $base);

        if (-d $path) {
            _search_recursive($base, $path, $name_re, $content_re, $max_depth, $depth + 1, $results);
        }
        elsif (-f $path) {
            # Check filename pattern
            my $name_match = !$name_re || $entry =~ $name_re;

            if ($name_match) {
                if ($content_re) {
                    # Search file content
                    if (open my $fh, '<', $path) {
                        my $line_num = 0;
                        while (my $line = <$fh>) {
                            $line_num++;
                            if ($line =~ $content_re) {
                                chomp $line;
                                $line = substr($line, 0, 100) . '...' if length($line) > 100;
                                push @$results, "$rel_path:$line_num: $line";
                                last if @$results >= 100;
                            }
                        }
                        close $fh;
                    }
                }
                else {
                    push @$results, $rel_path;
                }
            }
        }

        last if @$results >= 100;
    }
}

# Get system info - no command approval needed
sub _get_system_info {
    my ($session, $params, $loop) = @_;

    my $info_type = $params->{info_type} // 'all';
    my $future = $loop->new_future;

    my @info;

    if ($info_type eq 'all' || $info_type eq 'os') {
        push @info, "=== OS Information ===";
        push @info, "System: $^O";
        push @info, "Perl: $^V";
        if (open my $fh, '<', '/etc/os-release') {
            while (<$fh>) {
                chomp;
                push @info, $_ if /^(NAME|VERSION|PRETTY_NAME)=/;
            }
            close $fh;
        }
        push @info, "";
    }

    if ($info_type eq 'all' || $info_type eq 'disk') {
        push @info, "=== Disk Usage ===";
        my $cwd = $session->working_dir // getcwd();
        # Use POSIX statvfs if available, otherwise report working directory
        push @info, "Working directory: $cwd";
        push @info, "";
    }

    if ($info_type eq 'all' || $info_type eq 'memory') {
        push @info, "=== Memory ===";
        if ($^O eq 'darwin') {
            push @info, "(Memory info requires system command on macOS)";
        }
        elsif (-r '/proc/meminfo') {
            if (open my $fh, '<', '/proc/meminfo') {
                while (<$fh>) {
                    push @info, $_ if /^(MemTotal|MemFree|MemAvailable|Buffers|Cached):/;
                }
                close $fh;
            }