view release on metacpan or  search on metacpan

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

                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;
            }
        }
        push @info, "";
    }

    if ($info_type eq 'all' || $info_type eq 'processes') {
        push @info, "=== Current Process ===";
        push @info, "PID: $$";
        push @info, "User: " . (getpwuid($<) // $<);
        push @info, "";
    }

    $future->done(_mcp_result(join("\n", @info)));
    return $future;
}

# Helper: convert glob pattern to regex
sub _glob_to_regex {
    my ($glob) = @_;
    $glob =~ s/\./\\./g;
    $glob =~ s/\*/.*/g;
    $glob =~ s/\?/./g;
    return qr/^$glob$/i;
}

# Helper: format file permissions
sub _format_perms {
    my ($mode) = @_;
    my $perms = '';
    $perms .= ($mode & 0400) ? 'r' : '-';
    $perms .= ($mode & 0200) ? 'w' : '-';
    $perms .= ($mode & 0100) ? 'x' : '-';
    $perms .= ($mode & 0040) ? 'r' : '-';
    $perms .= ($mode & 0020) ? 'w' : '-';
    $perms .= ($mode & 0010) ? 'x' : '-';
    $perms .= ($mode & 0004) ? 'r' : '-';
    $perms .= ($mode & 0002) ? 'w' : '-';
    $perms .= ($mode & 0001) ? 'x' : '-';
    return $perms;
}

# Helper: format date for ls output
sub _format_date {
    my ($time) = @_;
    my @t = localtime($time);
    return sprintf("%s %2d %02d:%02d",
        (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$t[4]],
        $t[3], $t[2], $t[1]);
}

=head1 AUTHOR

LNATION, C<< <email at lnation.org> >>

=head1 LICENSE AND COPYRIGHT

This software is Copyright (c) 2026 by LNATION.

This is free software, licensed under:

  The Artistic License 2.0 (GPL Compatible)

=cut

1;