Tk based process tree viewer, was created with heavy ChatGPT assistence

tkpstree

#!/usr/bin/env pistachio-perl
# -*- perl -*-

use strict;
use warnings;
use Tk;
use Tk::ROText;
use Proc::ProcessTable;
use List::Util qw(first);
eval 'use Tie::IxHash';

# Global variables
my $mw;
my $text;

my %windows;

# Main subroutine
sub main {
    # Create main window and text widget
    $mw = MainWindow->new();
    $text = $mw->Scrolled('ROText',
        -font => '{Courier} 10',
        -width => 80,
        -height => 24,
	-wrap => 'none',
    )->pack(-fill => 'both', -expand => 1);
    $text->fontCreate('bold', -weight => 'bold');

    $mw->Button(-text => 'Update', -command => \&update_process_tree)->pack;

    update_process_tree();
}

sub update_process_tree {
    $text->delete('1.0', 'end');
    foreach my $tag ($text->tagNames) {
	$text->tagDelete($tag);
    }

    if (is_in_path('wmctrl')) {
	get_windows_info();
    }

    # Display process tree
    my $process_table = Proc::ProcessTable->new();
    my %children;
    tie %children, 'Tie::IxHash' if defined &Tie::IxHash::TIEHASH;
    foreach my $process (@{$process_table->table}) {
        push @{$children{$process->ppid}}, $process;
    }
    display_process_tree($text, \%children, $process_table->table, 1, 0);

    # Start main loop
    MainLoop();
}

# Recursively display a process and its children
sub display_process_tree {
    my ($text, $children, $table, $pid, $depth) = @_;

    my $process = first { $_->pid == $pid } @$table;
    if (!$process) {
	warn "Cannot find process $pid from table, skipping...\n";
	return;
    }

    # Print process information to the text widget
    my $cmdline = join(" ", @{$process->cmdline});
    $cmdline =~ s{\n.*}{...}s;
    my $ttydev = $process->ttydev // "";
    if ($ttydev =~ m{^/dev/char/}) { # not a (pseudo) terminal
	$ttydev = "";
    }
    my $age;
    if ($ttydev ne "") {
        my @stat = stat($ttydev);
        $age = time() - $stat[9];
    }
    my $line = sprintf("%s%s (pid=%d, cmdline=%s, tty=%s%s%s)\n",
        ("  " x $depth),
        $process->cmdline->[0] // '<no cmd>',
        $process->pid,
        $cmdline // '<no cmd>',
        $ttydev,
	($windows{$process->pid} ? ", title=$windows{$process->pid}->{title} X11geom=$windows{$process->pid}->{geometry}" : ""),
	(defined $age ? ", age=${age}s" : ""),
    );
    my $tag = "pid_" . $process->pid;
    if ($ttydev ne "") {
        $text->tag('bind', $tag, '<1>', sub { show_process_info($process) });
	$text->tag('configure', $tag, font => 'bold');
    }
    $text->insert('end', $line, $tag);

    # Recursively display child processes
    foreach my $child (@{$children->{$pid}}) {
        display_process_tree($text, $children, $table, $child->pid, $depth+1);
    }
}

# Show process information in a Toplevel
sub show_process_info {
    my ($process) = @_;

    my $top = $mw->Toplevel();
    my $pid = $process->pid;
    my $cmdline = join(" ", @{$process->cmdline});
    my $ttydev = $process->ttydev;
    my $label = $top->Label(
        -text => "PID: $pid\nCMDLINE: $cmdline\nTTYDEV: $ttydev",
    )->pack();
    my $last_state;

    my $state_label = $top->Label()->pack();
    my $repeat = $mw->repeat(1000, sub {
        my $age = 0;
        if ($ttydev ne "") {
            my @stat = stat($ttydev);
            $age = time() - $stat[9];
        }
        my $state = $age < 10 ? "active" : "inactive";
        $state_label->configure(-text => "TTY age: $age s\nState: $state");
	if (!defined $last_state) {
	    $last_state = $state;
	}
        if ($state ne $last_state) {
            $top->raise();
        }
	$last_state = $state;
    });

    if (is_in_path('wmctrl')) {
	# set sticky flag for gnome and fvwm2
	$top->update;
	my $hex_win_id = sprintf "0x%x", ($top->wrapper)[0];
	my @cmd = ('wmctrl', '-i', '-r', $hex_win_id, '-b', 'add,sticky');
	#warn "Run: @cmd\n";
	system @cmd;
	warn "@cmd failed: $?" if $? != 0;
    }

    $top->protocol('WM_DELETE_WINDOW' => sub {
        $mw->afterCancel($repeat);
        $top->destroy();
    });
}

sub get_windows_info {
    %windows = ();

    # Get list of windows with their properties using wmctrl
    my @windows_info = `wmctrl -lGp`;

    # Parse window information
    foreach my $window_info (@windows_info) {
	chomp($window_info);
	my ($w_id, $w_desk, $w_pid, $w_x, $w_y, $w_w, $w_h, $w_title) = split(/\s+/, $window_info, 8);
	my $geometry = "${w_w}x${w_h}+${w_x}+${w_y}";

	# Save window info in hash
	$windows{$w_pid} = {
	    title => $w_title,
	    geometry => $geometry,
	};
    }
}

# Call main subroutine
main();

# REPO BEGIN
# REPO NAME is_in_path /home/slaven_rezic/src/srezic-repository 
# REPO MD5 4be1e368fea0fa9af4e89256a9878820

=head2 is_in_path($prog)

=for category File

Return the pathname of $prog, if the program is in the PATH, or undef
otherwise.

=cut

sub is_in_path {
    my($prog) = @_;
    require File::Spec;
    if (File::Spec->file_name_is_absolute($prog)) {
	if ($^O eq 'MSWin32') {
	    return $prog       if (-f $prog && -x $prog);
	    return "$prog.bat" if (-f "$prog.bat" && -x "$prog.bat");
	    return "$prog.com" if (-f "$prog.com" && -x "$prog.com");
	    return "$prog.exe" if (-f "$prog.exe" && -x "$prog.exe");
	    return "$prog.cmd" if (-f "$prog.cmd" && -x "$prog.cmd");
	} else {
	    return $prog if -f $prog and -x $prog;
	}
    }
    require Config;
    %Config::Config = %Config::Config if 0; # cease -w
    my $sep = $Config::Config{'path_sep'} || ':';
    foreach (split(/$sep/o, $ENV{PATH})) {
	if ($^O eq 'MSWin32') {
	    # maybe use $ENV{PATHEXT} like maybe_command in ExtUtils/MM_Win32.pm?
	    return "$_\\$prog"     if (-f "$_\\$prog" && -x "$_\\$prog");
	    return "$_\\$prog.bat" if (-f "$_\\$prog.bat" && -x "$_\\$prog.bat");
	    return "$_\\$prog.com" if (-f "$_\\$prog.com" && -x "$_\\$prog.com");
	    return "$_\\$prog.exe" if (-f "$_\\$prog.exe" && -x "$_\\$prog.exe");
	    return "$_\\$prog.cmd" if (-f "$_\\$prog.cmd" && -x "$_\\$prog.cmd");
	} else {
	    return "$_/$prog" if (-x "$_/$prog" && !-d "$_/$prog");
	}
    }
    undef;
}
# REPO END