File Coverage

bin/lsjobs
Criterion Covered Total %
statement 57 465 12.2
branch 2 204 0.9
condition 1 99 1.0
subroutine 13 34 38.2
pod n/a
total 73 802 9.1


line stmt bran cond sub pod time code
1             #!/usr/bin/env perl
2             #ABSTRACT: List your jobs (or others), and delete them if you wish
3             #PODNAME: lsjobs
4              
5 1     1   6317 use v5.12;
  1         4  
6 1     1   7 use warnings;
  1         2  
  1         64  
7 1     1   806 use utf8;
  1         337  
  1         7  
8 1     1   1033 use Getopt::Long;
  1         20162  
  1         8  
9 1     1   832 use FindBin qw($RealBin);
  1         1642  
  1         135  
10 1     1   665 use Data::Dumper;
  1         11794  
  1         99  
11 1     1   740 use Term::ANSIColor qw(:constants);
  1         15610  
  1         1383  
12 1     1   29 use File::Basename;
  1         2  
  1         83  
13 1     1   1077 use Text::ASCIITable;
  1         10810  
  1         190  
14 1         125189 $Data::Dumper::Sortkeys = 1;
15              
16             # Enable UTF-8 output
17 1         6 binmode(STDOUT, ':utf8');
18 1         5 binmode(STDERR, ':utf8');
19              
20             # Box drawing characters for modern table rendering
21 1         49 my $BOX = {
22             tl => '┌', tr => '┐', bl => '└', br => '┘', # corners
23             h => '─', v => '│', # lines
24             t => '┬', b => '┴', l => '├', r => '┤', # T-junctions
25             c => '┼', # cross
26             };
27              
28 1 50       49 if (-e "$RealBin/../dist.ini") {
  0         0  
29 1 50       6 say STDERR "[dev mode] Using local lib" if ($ENV{"DEBUG"});
30 1     1   738 use lib "$RealBin/../lib";
  1         894  
  1         8  
31             }
32              
33 1     1   952 use NBI::Slurm;
  1         5  
  1         186  
34 1     1   11 use Cwd;
  1         2  
  1         116847  
35              
36              
37              
38              
39 1   50     9 my $current_slurm_jobid = $ENV{SLURM_JOBID} // -1;
40 1         3 my $unix_username = $ENV{USER};
41 1         4 my $user_home_dir = $ENV{HOME};
42              
43 1         2 my $opt_user = $unix_username;
44 1         3 my $opt_status = '.+';
45 1         2 my $opt_running_bool = 0;
46 1         3 my $opt_pending_bool = 0;
47 1         2 my $opt_delete_bool = 0;
48 1         2 my $opt_verbose_bool = 0;
49 1         2 my $opt_queue = '.+';
50 1         3 my $opt_name = '.+';
51 1         2 my $opt_tab = 0;
52 1         3 my @opt_hide = ();
53             GetOptions(
54             'u|user=s' => \$opt_user,
55             'n|name=s' => \$opt_name,
56             's|status=s'=> \$opt_status,
57             'r|running' => \$opt_running_bool,
58             'p|pending' => \$opt_pending_bool,
59             'd|delete' => \$opt_delete_bool,
60             't|tab' => \$opt_tab,
61             'hide=s' => \@opt_hide,
62             'verbose' => \$opt_verbose_bool,
63 1     1   1824 'version' => sub { say "lsjobs v", $NBI::Slurm::VERSION; exit },
  1         153  
64 0     0   0 'help' => sub { usage() },
65 1         18 );
66              
67 0 0       0 if (not NBI::Slurm::has_squeue()) {
68 0         0 say STDERR RED, "Error: ", RESET, "squeue not found in PATH. Are you in the cluster?";
69 0         0 exit 1;
70             }
71              
72 0         0 my $jobs = getjobs();
73              
74             # Check if we got any data
75 0 0 0     0 if (not defined $jobs or ref($jobs) ne 'HASH') {
76 0         0 say STDERR RED, "Error: ", RESET, "Failed to retrieve job information";
77 0         0 exit 1;
78             }
79 0         0 my @ids = ();
80 0         0 for my $positional (@ARGV) {
81 0 0       0 if ($positional =~ /^(\d+)$/) {
82 0         0 push(@ids, $1);
83             } else {
84 0 0       0 if ($opt_name eq '.+') {
85 0         0 $opt_name = $positional;
86             } else {
87 0         0 say STDERR "Error: unknown positional argument: $positional";
88 0         0 usage();
89             }
90             }
91             }
92              
93 0 0 0     0 if ($opt_user eq 'ALL' or $opt_user eq 'all') {
94 0         0 $opt_user = '.+';
95             }
96 0 0       0 if ($opt_verbose_bool) {
97 0         0 say STDERR "User: $opt_user";
98 0         0 say STDERR "Jobs: ", scalar(keys %{$jobs});
  0         0  
99             }
100              
101 0         0 my $selected_jobs = {};
102 0         0 my $selected_arrays = [['JobID', 'User', 'Queue', 'Name', 'State', 'Time', 'TotalTime', 'NodeList', 'CPUS', 'Memory', 'Reason']];
103              
104 0 0       0 if ($opt_tab) {
105             # Add "#" prefix for TSV mode
106 0         0 $selected_arrays->[0]->[0] = "#" . $selected_arrays->[0]->[0];
107             }
108              
109 0         0 for my $job (sort keys %{$jobs}) {
  0         0  
110             # Check user (full match)
111 0 0       0 if ($jobs->{$job}->{USER} !~ /^$opt_user$/) {
112 0         0 next;
113             }
114             # Check queue (partial match ok)
115 0 0       0 if ($jobs->{$job}->{PARTITION} !~ /$opt_queue/) {
116 0         0 next;
117             }
118              
119             # Check name
120 0 0       0 if ($jobs->{$job}->{NAME} !~ /$opt_name/) {
121 0         0 next;
122             }
123             # Check status (general pattern match)
124 0 0       0 if ($jobs->{$job}->{STATE} !~ /$opt_status/) {
125 0         0 next;
126             }
127             # Check specific status flags (these override general status pattern)
128 0 0 0     0 if ($opt_pending_bool and $jobs->{$job}->{STATE} ne 'PENDING') {
129 0         0 next;
130             }
131 0 0 0     0 if ($opt_running_bool and $jobs->{$job}->{STATE} ne 'RUNNING') {
132 0         0 next;
133             }
134 0 0 0     0 if (scalar @ids > 0 and not grep {$_ eq $job} @ids) {
  0         0  
135 0         0 next;
136             }
137              
138             # Format job ID for display (handle array jobs)
139 0         0 my $display_jobid = $jobs->{$job}->{JOBID};
140 0 0 0     0 if (defined $display_jobid && $display_jobid =~ /_/) {
141             # Array job format: convert "12345_1" to "12345#"
142 0         0 $display_jobid =~ s/_.*/#/;
143             }
144              
145             my $array = [$display_jobid // 'N/A',
146             $jobs->{$job}->{USER} // 'N/A',
147             $jobs->{$job}->{PARTITION} // 'N/A',
148             $jobs->{$job}->{NAME} // 'N/A',
149             $opt_tab ? ($jobs->{$job}->{STATE} // 'N/A') : state_string($jobs->{$job}->{STATE} // 'UNKNOWN'),
150             $jobs->{$job}->{TIME} // '0:00',
151             $jobs->{$job}->{TIME_LIMIT} // 'N/A',
152             $jobs->{$job}->{NODELIST} // 'N/A',
153             $jobs->{$job}->{"CPUS"} // 'N/A',
154             $jobs->{$job}->{"MIN_MEMORY"} // 'N/A',
155 0 0 0     0 $opt_tab ? ($jobs->{$job}->{"REASON"} // 'N/A') : reason_string($jobs->{$job}->{"REASON"} // 'None')
    0 0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
156             ];
157 0         0 push(@{$selected_arrays}, $array);
  0         0  
158              
159              
160             }
161             # Apply column hiding if requested
162 0 0 0     0 if (@opt_hide && !$opt_tab) {
163 0         0 $selected_arrays = hide_columns($selected_arrays, \@opt_hide);
164             }
165              
166             # Print summary header (not in tab mode)
167 0 0       0 if (!$opt_tab) {
168 0         0 print_summary($jobs, $selected_arrays);
169             }
170              
171 0 0       0 if ($opt_tab) {
172 0         0 for my $array (@{$selected_arrays}) {
  0         0  
173 0         0 say join("\t", @{$array});
  0         0  
174             }
175             } else {
176             # Render modern table with Unicode box drawing
177 0         0 render_table_modern(@{$selected_arrays});
  0         0  
178 0         0 print RESET, "\n";
179             }
180              
181             ## Print single job
182 0 0 0     0 if ($opt_verbose_bool and scalar @{$selected_arrays} == 3) {
  0         0  
183 0         0 my $job = extractJobByID($jobs, $selected_arrays->[2]->[0]);
184 0         0 for my $key (sort keys %{$job}) {
  0         0  
185             # Filter useless values
186 0 0 0     0 if ($job->{$key} =~ /^$/ or $job->{$key} =~ /^(\(null\)|\*)$/) {
187 0         0 next;
188             }
189 0 0       0 if ($key =~/(S_C_T|USER|ACCOUNT)/) {
190 0         0 next;
191             }
192 0         0 say YELLOW, sprintf("%-20s", $key), RESET, $job->{$key};
193             }
194             }
195              
196 0         0 my @selected_ids = joblist_to_ids(@{$selected_arrays});
  0         0  
197              
198              
199 0 0 0     0 if ($opt_delete_bool and (scalar @selected_ids)) {
    0          
200 0         0 say RED "\nDELETE JOBS:", RESET;
201 0 0       0 if (prompt("Delete " . scalar(@selected_ids) . " jobs?", 'n') =~ /^(y|Y|yes|YES)$/) {
202 0         0 my $command = "scancel " . join(" ", @selected_ids);
203 0         0 my $result = system($command);
204 0 0       0 if ($result == -1) {
    0          
    0          
205 0         0 say RED, "ERROR", RESET, ": Failed to execute scancel: $!";
206             } elsif ($result & 127) {
207 0         0 say RED, "ERROR", RESET, ": scancel died with signal ", ($result & 127);
208             } elsif (my $exit_code = $result >> 8) {
209 0         0 say RED, "ERROR", RESET, ": scancel exited with status $exit_code";
210             } else {
211 0         0 say GREEN, "Success", RESET, ": Deleted ", scalar(@selected_ids), " job(s)";
212             }
213             } else {
214 0         0 say "Deletion cancelled.";
215             }
216              
217             } elsif ($opt_delete_bool) {
218 0         0 say STDERR YELLOW, "Warning: ", RESET, "No jobs selected for deletion";
219             }
220              
221             sub state_string {
222 0   0 0     my $s = shift // 'UNKNOWN';
223 0           my ($icon, $color, $text);
224              
225 0 0         if ($s =~ /^R/i) {
    0          
    0          
    0          
    0          
226 0           $icon = '▶';
227 0           $color = GREEN . BOLD;
228 0           $text = 'RUN';
229             } elsif ($s =~ /^P/i) {
230 0           $icon = '◷';
231 0           $color = YELLOW . BOLD;
232 0           $text = 'PND';
233             } elsif ($s =~ /^C/i) {
234 0           $icon = '✓';
235 0           $color = CYAN . BOLD;
236 0           $text = 'CMP';
237             } elsif ($s =~ /^F/i) {
238 0           $icon = '✗';
239 0           $color = RED . BOLD;
240 0           $text = 'FLD';
241             } elsif ($s =~ /^S/i) {
242 0           $icon = '■';
243 0           $color = RED . BOLD;
244 0           $text = 'STP';
245             } else {
246 0           $icon = '?';
247 0           $color = WHITE;
248 0           $text = substr($s, 0, 3);
249             }
250              
251 0           return $color . $icon . ' ' . $text . RESET;
252             }
253             sub reason_string {
254 0   0 0     my $s = shift // 'None';
255 0           my ($icon, $color);
256              
257 0 0         if ($s =~ /^None/i) {
    0          
    0          
    0          
    0          
    0          
258 0           $icon = '✓';
259 0           $color = CYAN;
260 0           return $color . $icon . ' ' . $s . RESET;
261             } elsif ($s =~ /^Priority/i) {
262 0           $icon = '↑'; # was ⏳ — 2-wide emoji on modern terminals
263 0           $color = YELLOW;
264             } elsif ($s =~ /^Resources/i) {
265 0           $icon = '↯'; # was ⚡ — 2-wide emoji on modern terminals
266 0           $color = YELLOW;
267             } elsif ($s =~ /^Dependency/i) {
268 0           $icon = '→'; # was ⛓ — 2-wide emoji on modern terminals
269 0           $color = BLUE;
270             } elsif ($s =~ /^(Bad|Error|Invalid)/i) {
271 0           $icon = '✗';
272 0           $color = RED . BOLD;
273             } elsif ($s =~ /^QOS/i) {
274 0           $icon = '!'; # was ⚠ — ambiguous-width on modern terminals
275 0           $color = YELLOW;
276             } else {
277 0           $icon = '•';
278 0           $color = WHITE;
279             }
280              
281 0           return $color . $icon . ' ' . $s . RESET;
282             }
283             sub joblist_to_ids {
284             # Receive a list of lists (all same length) and returns a list of jobids
285 0     0     my @rows = @_;
286 0           my @ids = ();
287             # remove first two rows
288            
289 0           for my $row (@rows) {
290             # Skip non numeric values
291            
292 0 0         next if ($row->[0] !~ /^\d+$/);
293              
294 0           push @ids, $row->[0];
295            
296            
297             }
298              
299 0           return @ids;
300            
301             }
302             sub short_job {
303             # Print a line of minimal information about a job
304 0     0     my $line_width = get_terminal_width();
305 0           my $job = shift;
306 0           my $jobid = $job->{JOBID};
307 0           my $name = $job->{NAME};
308 0           my $state = $job->{STATE};
309 0           my $user = $job->{USER};
310 0           my $queue = $job->{PARTITION};
311 0           my $time = $job->{TIME};
312             # Return a string sorther than $line_width
313 0           my $line = sprintf("%-10s %-10s %-10s %-10s %-10s %-10s", $jobid, $name, $state, $user, $queue, $time);
314 0           return $line;
315             }
316              
317             sub print_summary {
318 0     0     my ($jobs, $selected_arrays) = @_;
319 0           my %stats = (running => 0, pending => 0, completed => 0, failed => 0, other => 0);
320              
321             # Count job states
322 0           for my $job (values %$jobs) {
323 0   0       my $state = $job->{STATE} // '';
324 0 0         if ($state =~ /^R/i) {
    0          
    0          
    0          
325 0           $stats{running}++;
326             } elsif ($state =~ /^P/i) {
327 0           $stats{pending}++;
328             } elsif ($state =~ /^C/i) {
329 0           $stats{completed}++;
330             } elsif ($state =~ /^F/i) {
331 0           $stats{failed}++;
332             } else {
333 0           $stats{other}++;
334             }
335             }
336              
337 0           my $total = scalar(keys %$jobs);
338 0           my $showing = scalar(@$selected_arrays) - 1; # -1 for header row
339              
340 0           say '';
341 0           say BOLD . CYAN . '╔════════════════════════════════════════════════════════════════╗' . RESET;
342 0           say BOLD . CYAN . '║' . RESET . ' ' . BOLD . 'SLURM Job Queue Summary' . RESET . ' ' x 38 . BOLD . CYAN . '║' . RESET;
343 0           say BOLD . CYAN . '╚════════════════════════════════════════════════════════════════╝' . RESET;
344 0           say '';
345              
346             # Stats line
347 0           my @stat_parts;
348             push @stat_parts, sprintf('%s %-9s %s%3d%s',
349 0 0         GREEN . BOLD . '▶' . RESET, 'Running:', GREEN . BOLD, $stats{running}, RESET) if $stats{running};
350             push @stat_parts, sprintf('%s %-9s %s%3d%s',
351 0 0         YELLOW . BOLD . '◷' . RESET, 'Pending:', YELLOW . BOLD, $stats{pending}, RESET) if $stats{pending};
352             push @stat_parts, sprintf('%s %-9s %s%3d%s',
353 0 0         CYAN . '✓' . RESET, 'Complete:', CYAN, $stats{completed}, RESET) if $stats{completed};
354             push @stat_parts, sprintf('%s %-9s %s%3d%s',
355 0 0         RED . BOLD . '✗' . RESET, 'Failed:', RED . BOLD, $stats{failed}, RESET) if $stats{failed};
356             push @stat_parts, sprintf('%s %-9s %s%3d%s',
357 0 0         WHITE . '•' . RESET, 'Other:', WHITE, $stats{other}, RESET) if $stats{other};
358              
359 0 0         if (@stat_parts) {
360 0           say ' ' . join(' ', @stat_parts);
361             }
362              
363 0           say '';
364 0           say sprintf(' %s Showing: %s%d%s of %s%d%s total jobs',
365             CYAN . BOLD . '→' . RESET,
366             BOLD . CYAN, $showing, RESET,
367             BOLD, $total, RESET
368             );
369 0           say '';
370             }
371              
372             sub hide_columns {
373 0     0     my ($arrays_ref, $hide_patterns) = @_;
374 0 0         return $arrays_ref unless @$hide_patterns;
375              
376 0           my @arrays = @$arrays_ref;
377 0 0         return \@arrays unless @arrays;
378              
379 0           my $header = $arrays[0];
380 0           my @keep_indices;
381              
382             # Determine which columns to keep
383 0           for my $i (0..$#{$header}) {
  0            
384 0           my $col_name = $header->[$i];
385 0           my $should_hide = 0;
386              
387 0           for my $pattern (@$hide_patterns) {
388             # Case insensitive substring match (minimum 3 chars)
389 0 0 0       if (length($pattern) >= 3 && $col_name =~ /\Q$pattern\E/i) {
390 0           $should_hide = 1;
391 0           last;
392             }
393             }
394              
395 0 0         push @keep_indices, $i unless $should_hide;
396             }
397              
398             # If all columns would be hidden, keep them all
399 0 0         return \@arrays unless @keep_indices;
400              
401             # Filter each row to keep only non-hidden columns
402 0           my @filtered_arrays;
403 0           for my $row (@arrays) {
404 0           my @filtered_row = map { $row->[$_] } @keep_indices;
  0            
405 0           push @filtered_arrays, \@filtered_row;
406             }
407              
408 0           return \@filtered_arrays;
409             }
410              
411             sub ansi_first_char {
412             # Return the first visible glyph of an ANSI-coloured string,
413             # preserving any leading colour escape sequences.
414 0     0     my $s = shift;
415 0           my $prefix = '';
416 0           while ($s =~ s/^(\e\[[0-9;]*m)//) {
417 0           $prefix .= $1;
418             }
419 0           return $prefix . substr($s, 0, 1) . RESET;
420             }
421              
422             sub fit_columns_to_terminal {
423             # Given natural column widths and the header row, return:
424             # ($fitted_widths_ref, $hidden_hashref, $icon_only_hashref)
425             # Strategy (in order):
426             # 1. Shrink flexible cols (name, nodelist, reason) down to their minimums
427             # 2. Hide NodeList entirely (optional column, first to go)
428             # 3. Hide Reason entirely (optional column, second to go)
429             # 4. Collapse State to icon-only glyph
430             # 5. Last-resort: truncate whatever is still widest
431 0     0     my ($widths, $header) = @_;
432 0           my $terminal_width = get_terminal_width();
433              
434 0           my @fitted = @$widths;
435 0           my %hidden = ();
436 0           my %icon_only = ();
437              
438             # Map normalised column name -> index
439 0           my %col_idx;
440 0           for my $i (0..$#$header) {
441 0           my $name = lc($header->[$i]);
442 0           $name =~ s/[^a-z0-9]//g;
443 0           $col_idx{$name} = $i;
444             }
445              
446             # Rendered width: left border + each visible col (content + 2 spaces + right border)
447             my $calc_width = sub {
448 0     0     my $w = 1;
449 0           for my $i (0..$#fitted) {
450 0 0         next if $hidden{$i};
451 0           $w += $fitted[$i] + 3;
452             }
453 0           return $w;
454 0           };
455              
456 0 0         return (\@fitted, \%hidden, \%icon_only) if $calc_width->() <= $terminal_width;
457              
458             # Step 1: Shrink Name/NodeList/Reason down to minimums
459 0           my %min_widths = (name => 10, nodelist => 8, reason => 8);
460 0           my $progress = 1;
461 0   0       while ($calc_width->() > $terminal_width && $progress) {
462 0           $progress = 0;
463 0           my ($best, $best_w) = (undef, 0);
464 0           for my $name (qw(name nodelist reason)) {
465 0           my $i = $col_idx{$name};
466 0 0         next unless defined $i;
467 0 0         next if $hidden{$i};
468 0           my $min = $min_widths{$name};
469 0 0 0       if ($fitted[$i] > $min && $fitted[$i] > $best_w) {
470 0           $best = $name;
471 0           $best_w = $fitted[$i];
472             }
473             }
474 0 0         if (defined $best) {
475 0           my $i = $col_idx{$best};
476 0           my $min = $min_widths{$best};
477 0           my $excess = $calc_width->() - $terminal_width;
478 0           my $cut = $fitted[$i] - $min;
479 0 0         $cut = $excess if $excess < $cut;
480 0           $fitted[$i] -= $cut;
481 0 0         $progress = 1 if $cut > 0;
482             }
483             }
484              
485             # Step 2: Hide NodeList (optional, first to go)
486 0 0         if ($calc_width->() > $terminal_width) {
487 0           my $i = $col_idx{nodelist};
488 0 0         $hidden{$i} = 1 if defined $i;
489             }
490              
491             # Step 3: Hide Reason (optional, second to go)
492 0 0         if ($calc_width->() > $terminal_width) {
493 0           my $i = $col_idx{reason};
494 0 0         $hidden{$i} = 1 if defined $i;
495             }
496              
497             # Step 4: Collapse State to a single icon glyph
498 0 0         if ($calc_width->() > $terminal_width) {
499 0           my $i = $col_idx{state};
500 0 0 0       if (defined $i && !$hidden{$i}) {
501 0           $icon_only{$i} = 1;
502 0           $fitted[$i] = 1;
503             }
504             }
505              
506             # Step 5: Last-resort generic truncation of whatever is still widest
507 0           $progress = 1;
508 0   0       while ($calc_width->() > $terminal_width && $progress) {
509 0           $progress = 0;
510 0           my ($best_i, $best_w) = (-1, 0);
511 0           for my $i (0..$#fitted) {
512 0 0 0       next if $hidden{$i} || $icon_only{$i};
513 0 0 0       if ($fitted[$i] > 4 && $fitted[$i] > $best_w) {
514 0           $best_i = $i;
515 0           $best_w = $fitted[$i];
516             }
517             }
518 0 0         if ($best_i >= 0) {
519 0           my $excess = $calc_width->() - $terminal_width;
520 0           my $cut = $fitted[$best_i] - 4;
521 0 0         $cut = $excess if $excess < $cut;
522 0           $fitted[$best_i] -= $cut;
523 0 0         $progress = 1 if $cut > 0;
524             }
525             }
526              
527 0           return (\@fitted, \%hidden, \%icon_only);
528             }
529              
530             sub render_table_modern {
531             # Receive a list of lists (all same length) and print a modern table with Unicode borders
532 0     0     my @rows = @_;
533 0 0         return unless @rows;
534              
535 0           my $n_cols = scalar(@{$rows[0]});
  0            
536              
537             # Calculate maximum widths for each column
538 0           my @max_widths = ();
539 0           for my $col (0..$n_cols-1) {
540 0           my $max_width = 0;
541 0           for my $row (@rows) {
542 0           my $width = ascii_len($row->[$col]);
543 0 0         $max_width = $width if ($width > $max_width);
544             }
545 0           push(@max_widths, $max_width);
546             }
547              
548             # Fit columns to terminal: truncate, hide optional cols, collapse State to icon
549 0           my ($fitted_widths, $hidden_cols, $icon_only_cols) =
550             fit_columns_to_terminal(\@max_widths, $rows[0]);
551              
552             # Print top border
553 0           print_border_line('top', $fitted_widths, $hidden_cols);
554              
555             # Print header row (first row)
556 0 0         if (@rows > 0) {
557 0           print_table_row($rows[0], $fitted_widths, 'header', $hidden_cols, $icon_only_cols);
558 0           print_border_line('middle', $fitted_widths, $hidden_cols);
559             }
560              
561             # Print data rows
562 0           for my $i (1..$#rows) {
563 0           print_table_row($rows[$i], $fitted_widths, 'data', $hidden_cols, $icon_only_cols);
564             }
565              
566             # Print bottom border
567 0           print_border_line('bottom', $fitted_widths, $hidden_cols);
568             }
569              
570             sub print_border_line {
571 0     0     my ($type, $widths, $hidden) = @_;
572 0   0       $hidden //= {};
573 0           my ($left, $mid, $right, $fill);
574              
575 0 0         if ($type eq 'top') {
    0          
576 0           ($left, $mid, $right, $fill) = ($BOX->{tl}, $BOX->{t}, $BOX->{tr}, $BOX->{h});
577             } elsif ($type eq 'middle') {
578 0           ($left, $mid, $right, $fill) = ($BOX->{l}, $BOX->{c}, $BOX->{r}, $BOX->{h});
579             } else { # bottom
580 0           ($left, $mid, $right, $fill) = ($BOX->{bl}, $BOX->{b}, $BOX->{br}, $BOX->{h});
581             }
582              
583 0           my @visible = grep { !$hidden->{$_} } 0..$#{$widths};
  0            
  0            
584 0           print CYAN . $left . RESET;
585 0           for my $j (0..$#visible) {
586 0           my $i = $visible[$j];
587 0           print CYAN . ($fill x ($widths->[$i] + 2)) . RESET;
588 0 0         print CYAN . ($j == $#visible ? $right : $mid) . RESET;
589             }
590 0           say '';
591             }
592              
593             sub print_table_row {
594 0     0     my ($row, $widths, $style, $hidden, $icon_only) = @_;
595 0   0       $hidden //= {};
596 0   0       $icon_only //= {};
597              
598 0           print CYAN . $BOX->{v} . RESET;
599 0           for my $i (0..$#{$row}) {
  0            
600 0 0         next if $hidden->{$i};
601              
602 0           my $cell = $row->[$i];
603 0           my $width = $widths->[$i];
604              
605             # Icon-only mode: show just the leading glyph (used for State when space is tight)
606 0 0         if ($icon_only->{$i}) {
607 0           my $icon = ansi_first_char($cell);
608 0           print " $icon " . RESET;
609 0           print CYAN . $BOX->{v} . RESET;
610 0           next;
611             }
612              
613 0           my $stripped = $cell;
614 0           $stripped =~ s/\e\[[0-9;]*m//g; # Strip ANSI codes
615              
616 0 0         my $prefix = ($style eq 'header') ? BOLD . WHITE : '';
617              
618 0 0         if (length($stripped) > $width) {
619             # Truncate and mark with a coloured '>' ellipsis
620 0           my $visible = substr($stripped, 0, $width - 1);
621 0           print " $prefix$visible" . YELLOW . BOLD . '>' . RESET . ' ';
622             } else {
623             # Normal padded cell — preserve ANSI codes in the original value
624 0           my $tmpline = sprintf(" %s%-*s ", $prefix, $width, $stripped);
625 0           my $index = index($tmpline, $stripped);
626 0 0         if ($index >= 0) {
627 0           substr($tmpline, $index, length($stripped), $cell);
628             }
629 0           print $tmpline . RESET;
630             }
631 0           print CYAN . $BOX->{v} . RESET;
632             }
633 0           say '';
634             }
635              
636             sub render_table {
637             # Receive a list of lists (all same length) and print a table not larger than $line_width
638            
639             # @_ is an array of array references
640 0     0     my @rows = @_;
641 0           my $n_cols = scalar(@{$rows[0]});
  0            
642 0           my $line_width = get_terminal_width() - $n_cols - 1;
643             # For each column, evaluate the maximum string contained in that column
644 0           my @max_widths = ();
645 0           for my $col (0..$n_cols-1) {
646 0           my $max_width = 0;
647 0           for my $row (@rows) {
648 0           my $width = ascii_len($row->[$col]);
649 0 0         $max_width = $width if ($width > $max_width);
650             }
651 0           push(@max_widths, $max_width);
652             }
653             # Now print the table
654 0           for my $row (@rows) {
655 0           my $line = WHITE . ON_BLACK;
656 0           for my $col (0..$n_cols-1) {
657 0           my $width = $max_widths[$col];
658 0           my $cell = $row->[$col];
659 0           my $stripped = $cell;
660 0           $stripped =~ s/\e\[[0-9;]*m//g;
661 0           my $tmpline = sprintf("|%-${width}s ", $stripped);
662             # In tmpline replace $stripped with $cell, without using regex
663 0           my $index = index($tmpline, $stripped);
664 0           substr($tmpline, $index, length($stripped), $cell);
665 0           $line .= $tmpline;
666             }
667 0           say $line, "|";
668             }
669 0           print RESET;
670             }
671              
672             sub ascii_len {
673 0     0     my $string = shift;
674             # Return legnth excluding ANSI escape sequences
675 0           $string =~ s/\e\[[0-9;]*m//g;
676 0           return length($string);
677             }
678              
679             sub extractJobByID {
680 0     0     my ($jobs, $id) = @_;
681 0           my $job = {};
682 0           for my $jobid (keys %{$jobs}) {
  0            
683 0 0         if ($jobid eq $id) {
684 0           $job = $jobs->{$jobid};
685 0           last;
686             }
687             }
688 0           return $job;
689             }
690             sub getjobs {
691             # Create an anonymous hash, and return it
692 0     0     my $jobs = {};
693             # Use specific format for efficiency - only get fields we need
694 0           my $cmd = q(squeue --format='%i|%u|%P|%j|%T|%M|%l|%N|%C|%m|%r');
695 0           my @output = `$cmd 2>&1`;
696              
697             # Check if command failed
698 0 0         if ($? != 0) {
699 0           say STDERR RED, "Error: ", RESET, "Failed to execute squeue command";
700 0 0         say STDERR "Output: ", join("\n", @output) if @output;
701 0           return $jobs;
702             }
703              
704 0           my $c = 0;
705 0           my @header = ();
706 0           for my $line (@output) {
707 0           chomp $line;
708 0 0         next if $line =~ /^\s*$/; # Skip empty lines
709              
710 0           my @fields = split(/\|/, $line);
711 0           $c++;
712 0 0         if ($c == 1 ) {
713             # Field names
714 0           for my $field (@fields) {
715 0           push(@header, stripchars($field));
716             }
717             } else {
718             # Job info
719 0           my $job = {};
720 0 0         if (scalar(@fields) != scalar(@header)) {
721 0           say STDERR YELLOW, "Warning: ", RESET, "Skipping malformed line (field count mismatch)";
722 0 0         if ($ENV{DEBUG}) {
723 0           say STDERR " Expected: ", scalar(@header), " fields";
724 0           say STDERR " Got: ", scalar(@fields), " fields";
725 0           say STDERR " Line: $line";
726             }
727 0           next; # Skip this line instead of exiting
728             }
729 0           for my $i (0..$#header) {
730 0 0         $job->{"$header[$i]"} = $fields[$i] if (not defined $job->{"$header[$i]"});
731             }
732              
733             # Ensure we have a valid JOBID before adding
734 0 0 0       if (defined $job->{JOBID} && $job->{JOBID} ne '') {
735 0           $jobs->{$job->{JOBID}} = $job;
736             } else {
737 0 0         say STDERR YELLOW, "Warning: ", RESET, "Skipping job with missing JOBID" if $ENV{DEBUG};
738             }
739              
740             }
741              
742             }
743              
744 0           return $jobs;
745             }
746              
747              
748             sub get_terminal_width {
749 0     0     my $terminal_width = `tput cols 2>/dev/null`;
750 0 0         chomp($terminal_width) if defined $terminal_width;
751              
752             # Validate that we got a positive integer
753 0 0 0       if (defined $terminal_width && $terminal_width =~ /^\d+$/ && $terminal_width > 20) {
      0        
754 0           return $terminal_width;
755             }
756              
757             # Fallback to default width
758 0           return 80;
759             }
760              
761             sub stripchars {
762 0     0     my $string = shift;
763             # replace non alphanumeric characters with _
764 0           $string =~ s/[^A-Za-z0-9]/_/g;
765 0           return $string;
766             }
767              
768             sub prompt {
769 0     0     my ($message, $default) = @_;
770 0           my $prompt = "$message [$default]: ";
771 0           print $prompt;
772 0           my $answer = ;
773 0           chomp $answer;
774 0 0         $answer = $default if ($answer eq '');
775 0           return $answer;
776             }
777              
778             sub usage {
779 0     0     say <
780             Usage: lsjobs [options] [jobid ... | pattern ]
781             ----------------------------------------------
782             Options:
783             -u, --user Show only jobs from this user [default: $unix_username]
784             Type 'all' to show all users
785              
786             -n, --name Show only jobs with this name (regex) [default: .+]
787              
788             -s, --status Show only jobs matching this status (regex) [default: .+]
789             -r, --running Show only running jobs
790             -p, --pending Show only pending jobs
791             -t, --tab Output in simple TSV format (pipe to vd for interactive table)
792              
793             --hide Hide column from display (case insensitive substring match,
794             minimum 3 characters). Can be specified multiple times.
795             Examples: --hide time --hide memory --hide nodelist
796              
797             -d, --delete Delete the selected jobs (with confirmation prompt)
798             --verbose Show verbose output
799             --version Show version and exit
800             --help Show this help message
801             END
802 0           exit;
803              
804             }
805              
806             __END__