From 59b57340b157755d635eb15432b995d086ee48e2 Mon Sep 17 00:00:00 2001
From: Gerhard Gonter <ggonter@gmail.com>
Date: Sun, 29 Oct 2023 08:56:05 +0100
Subject: [PATCH] added Parse::CMD::lsof and Parse::ZonedTables
---
debian/control | 2 +-
modules/util/Parse/CMD/lsof.pm | 38 +++++++++++++
modules/util/Parse/ZonedTables.pm | 94 +++++++++++++++++++++++++++++++
3 files changed, 133 insertions(+), 1 deletion(-)
create mode 100644 modules/util/Parse/CMD/lsof.pm
create mode 100644 modules/util/Parse/ZonedTables.pm
diff --git a/debian/control b/debian/control
index 17142f7..0c4bc6c 100644
--- a/debian/control
+++ b/debian/control
@@ -1,5 +1,5 @@
Package: libgg-aix-pm-perl
-Version: 0.6-1
+Version: 0.7-1
Architecture: all
Maintainer: Gerhard Gonter <ggonter@gmail.com>
Original-Maintainer: Gerhard Gonter <ggonter@gmail.com>
diff --git a/modules/util/Parse/CMD/lsof.pm b/modules/util/Parse/CMD/lsof.pm
new file mode 100644
index 0000000..603836d
--- /dev/null
+++ b/modules/util/Parse/CMD/lsof.pm
@@ -0,0 +1,38 @@
+
+package Parse::CMD::lsof;
+
+use strict;
+
+use Parse::ZonedTables;
+
+sub get_lsof_list
+{
+ open(LSOF, '-|', 'lsof') or die;
+ my $hdr= <LSOF>; chop($hdr);
+
+ # V1:
+ # my $fields= Parse::ZonedTables->new();
+ # $fields->get_fields($hdr);
+
+ # V2:
+ my $fields= Parse::ZonedTables->get_fields($hdr);
+
+ my @lines;
+ my %pids;
+ while (my $l= <LSOF>)
+ {
+ chop($l);
+ # print __LINE__, " lsof: l=[$l]\n";
+ my $rec= $fields->match_fields($l);
+ $rec->{_line}= $l; $rec->{_head}= $hdr; # used for debugging
+ # print __LINE__, " rec: ", Dumper($rec);
+ push (@lines, $rec);
+ push (@{$pids{$rec->{PID}}->{$rec->{TID}}} => $rec);
+ }
+ close(LSOF);
+
+ (\@lines, \%pids);
+}
+
+1;
+
diff --git a/modules/util/Parse/ZonedTables.pm b/modules/util/Parse/ZonedTables.pm
new file mode 100644
index 0000000..709248f
--- /dev/null
+++ b/modules/util/Parse/ZonedTables.pm
@@ -0,0 +1,94 @@
+
+package Parse::ZonedTables;
+
+# TODO: this is not a good nme, find something better!
+
+use strict;
+
+# use Data::Dumper;
+
+sub new
+{
+ my $class= shift;
+ my $self= bless({}, $class);
+ $self;
+}
+
+sub get_fields
+{
+ my $self= shift;
+ my $header= shift;
+
+ my $r= ref($self);
+ # print __LINE__, " r=[$r] self=[$self]\n";
+ $self= new($self) if ($r eq '');
+
+ my $lng= length($header);
+ my $st= 0;
+ my $word;
+ my @header= ();
+ my $field_num= 0;
+ for (my $i= 0; $i < $lng; $i++)
+ {
+ my $c= substr($header, $i, 1);
+ # print __LINE__, " i=[$i] c=[$c] st=[$st]\n";
+
+ if ($c ne ' ' && $st == 0) # new word
+ {
+ push(@header, $word= { label => $c, idx => $i, field_num => $field_num++ });
+ $st= 1;
+ }
+ elsif ($c ne ' ' && $st == 1) # next char of same wor
+ {
+ $word->{label} .= $c;
+ }
+ elsif ($c eq ' ' && $st == 1)
+ {
+ $st= 0;
+ }
+ }
+
+ # print __LINE__, " header: ", Dumper(\@header);
+
+ # (wantarray) ? @header : \@header;
+ $self->{fields}= \@header;
+
+ $self;
+}
+
+sub match_fields
+{
+ my $self= shift;
+ my $l= shift;
+
+ my $fields= $self->{fields};
+
+ my $last_field_num= $#$fields;
+ # print __LINE__, " last_field_num=[$last_field_num]\n";
+ # match fields right to lef
+ my $last_idx= length($l);
+ my %rec;
+ for (my $i= $last_field_num; $i >= 0; $i--)
+ {
+ my $f= $fields->[$i];
+ my ($idx, $label)= map { $f->{$_} } qw(idx label);
+
+ my $str= substr($l, $idx, $last_idx-$idx);
+ # there can be right-flushed fields, e.g. PID from lsof, so check, if there is something to the left of from the index of that label and add it to the string, if necessary
+ while ($idx > 0 && (my $x= substr($l, $idx-1, 1)) ne ' ')
+ {
+ $str= $x . $str;
+ $idx--;
+ }
+ $str =~ s#^ *##; $str =~ s# *$##; # remove padding blanks from the begin and end
+
+ $rec{$label}= $str;
+ # print __LINE__, " field i=[$i] idx=[$idx] last_idx=[$last_idx] label=[$label] str=[$str] f: ", Dumper($f);
+ $last_idx= $idx;
+ }
+
+ (wantarray) ? %rec : \%rec;
+}
+
+1;
+
--
GitLab