use
5.006;
our
$VERSION
=
'0.2.0'
;
sub
new{
my
%args
;
if
(
defined
(
$_
[1])) {
%args
= %{
$_
[1]};
}
my
$self
= {
colors
=>[
'BRIGHT_YELLOW'
,
'BRIGHT_CYAN'
,
'BRIGHT_MAGENTA'
,
'BRIGHT_BLUE'
],
nextColor
=>0,
timeColors
=>[
'GREEN'
,
'BRIGHT_GREEN'
,
'RED'
,
'BRIGHT_RED'
],
vszColors
=>[
'GREEN'
,
'YELLOW'
,
'RED'
,
'BRIGHT_BLUE'
],
rssColors
=>[
'BRIGHT_GREEN'
,
'BRIGHT_YELLOW'
,
'BRIGHT_RED'
,
'BRIGHT_BLUE'
],
file_colors
=>[
'BRIGHT_YELLOW'
,
'BRIGHT_CYAN'
,
'BRIGHT_MAGENTA'
,
'BRIGHT_BLUE'
,
'MAGENTA'
,
'BRIGHT_RED'
],
processColor
=>
'BRIGHT_RED'
,
varColor
=>
'GREEN'
,
valColor
=>
'WHITE'
,
pidColor
=>
'BRIGHT_CYAN'
,
cpuColor
=>
'BRIGHT_MAGENTA'
,
memColor
=>
'BRIGHT_BLUE'
,
zero_time
=>1,
zero_flt
=>1,
files
=>1,
idColors
=>[
'WHITE'
,
'BRIGHT_BLUE'
,
'MAGENTA'
,
],
is
=>Proc::ProcessTable::InfoString->new,
colors
=>[
'BRIGHT_YELLOW'
,
'BRIGHT_CYAN'
,
'BRIGHT_MAGENTA'
,
'BRIGHT_BLUE'
],
environ
=>
'BRIGHT_MAGENTA'
,
txt
=>0,
pipe
=>0,
unix
=>0,
vregroot
=>0,
dont_dedup
=>0,
dont_resolv
=>0,
fifo
=>0,
a_inode
=>0,
memreglib
=>0,
};
bless
$self
;
my
@arg_feed
=(
'txt'
,
'pipe'
,
'unix'
,
'vregroot'
,
'dont_dedup'
,
'dont_resolv'
,
'fifo'
,
'a_inore'
,
'memreglib'
);
foreach
my
$feed
(
@arg_feed
){
$self
->{
$feed
}=
$args
{
$feed
};
}
return
$self
;
}
sub
run{
my
$self
=
$_
[0];
my
@pids
;
if
(
defined
(
$_
[1])) {
@pids
= @{
$_
[1]};
}
if
( !
defined
(
$pids
[0] ) ){
return
''
;
}
my
%pids_hash
;
foreach
my
$pid
(
@pids
){
$pids_hash
{
$pid
}=
$pid
;
}
my
$p
= Proc::ProcessTable->new;
my
$pt
=
$p
->table;
my
@proc_keys
=
keys
( %{
$pt
->[0] } );
my
%proc_keys_hash
;
foreach
my
$proc_key
(
@proc_keys
){
$proc_keys_hash
{
$proc_key
}=1;
}
delete
(
$proc_keys_hash
{pctcpu} );
delete
(
$proc_keys_hash
{uid} );
delete
(
$proc_keys_hash
{pid} );
delete
(
$proc_keys_hash
{gid} );
delete
(
$proc_keys_hash
{vmsize} );
delete
(
$proc_keys_hash
{rss} );
delete
(
$proc_keys_hash
{state} );
delete
(
$proc_keys_hash
{wchan} );
delete
(
$proc_keys_hash
{cmndline} );
delete
(
$proc_keys_hash
{size} );
delete
(
$proc_keys_hash
{
time
} );
if
(
defined
(
$proc_keys_hash
{pctmem} ) ){
delete
(
$proc_keys_hash
{pctmem} );
}
if
(
defined
(
$proc_keys_hash
{groups} ) ){
delete
(
$proc_keys_hash
{groups} );
}
if
(
defined
(
$proc_keys_hash
{cmdline} ) ){
delete
(
$proc_keys_hash
{cmdline} );
}
@proc_keys
=
sort
(
keys
(
%proc_keys_hash
));
my
@procs
;
foreach
my
$proc
( @{
$pt
} ){
if
(
defined
(
$pids_hash
{
$proc
->pid } ) ){
push
(
@procs
,
$proc
);
}
}
if
(!
defined
(
$procs
[0] )){
return
''
}
my
$toReturn
=
''
;
my
$first
=1;
foreach
my
$proc
(
@procs
){
my
$tb
= Text::ANSITable->new;
$tb
->border_style(
'Default::none_ascii'
);
$tb
->color_theme(
'Default::no_color'
);
$tb
->show_header(0);
$tb
->set_column_style(0,
pad
=> 0);
$tb
->set_column_style(1,
pad
=> 1);
$tb
->columns( [
'var'
,
'val'
] );
my
@data
;
push
(
@data
, [
color(
$self
->{varColor} ).
'PID'
.color(
'reset'
),
color(
$self
->{pidColor} ).
$proc
->pid.color(
'reset'
)
]);
my
$user
=
getpwuid
(
$proc
->{uid});
if
( !
defined
(
$user
) ) {
$user
=color(
$self
->{idColors}[0] ).
$proc
->{uid}.color(
'reset'
);
}
else
{
$user
=color(
$self
->{idColors}[0] ).
$user
.
color(
$self
->{idColors}[1] ).
'('
.
color(
$self
->{idColors}[2] ).
$proc
->{uid}.
color(
$self
->{idColors}[1] ).
')'
.color(
'reset'
);
}
push
(
@data
, [
color(
$self
->{varColor} ).
'UID'
.color(
'reset'
),
$user
.
' '
.color(
'reset'
)
]);
my
$group
=
getgrgid
(
$proc
->{gid});
if
( !
defined
(
$group
) ) {
$group
=color(
$self
->{idColors}[0] ).
$proc
->{gid}.color(
'reset'
);
}
else
{
$group
=color(
$self
->{idColors}[0] ).
$group
.
color(
$self
->{idColors}[1] ).
'('
.
color(
$self
->{idColors}[2] ).
$proc
->{gid}.
color(
$self
->{idColors}[1] ).
')'
.color(
'reset'
);
}
push
(
@data
, [
color(
$self
->{varColor} ).
'GID'
.color(
'reset'
),
$group
.
' '
.color(
'reset'
)
]);
if
(
defined
(
$proc
->{groups} ) ){
my
@groups
;
foreach
my
$current_group
( @{
$proc
->{groups} } ){
$group
=
getgrgid
(
$current_group
);
if
( !
defined
(
$group
) ) {
$group
=color(
$self
->{idColors}[0] ).
$current_group
.color(
'reset'
);
}
else
{
$group
=color(
$self
->{idColors}[0] ).
$group
.
color(
$self
->{idColors}[1] ).
'('
.
color(
$self
->{idColors}[2] ).
$current_group
.
color(
$self
->{idColors}[1] ).
')'
.color(
'reset'
);
}
push
(
@groups
,
$group
);
}
push
(
@data
, [
color(
$self
->{varColor} ).
'Groups'
.color(
'reset'
),
join
(
' '
,
@groups
)
]);
}
push
(
@data
, [
color(
$self
->{varColor} ).
'CPU%'
.color(
'reset'
),
color(
$self
->{valColor} ).
$proc
->pctcpu.color(
'reset'
)
]);
my
$mem
;
if
( !
defined
(
$proc
->{pctmem} ) ) {
$mem
=(
$proc
->{rss} / totalmem)*100;
$mem
=
sprintf
(
'%.2f'
,
$mem
);
}
else
{
$mem
=
sprintf
(
'%.2f'
,
$proc
->{pctmem});
}
push
(
@data
, [
color(
$self
->{varColor} ).
'MEM%'
.color(
'reset'
),
color(
$self
->{valColor} ).
$mem
.color(
'reset'
)
]);
push
(
@data
, [
color(
$self
->{varColor} ).
'VSZ'
.color(
'reset'
),
$self
->memString(
$proc
->size,
'vsz'
)
]);
push
(
@data
, [
color(
$self
->{varColor} ).
'RSS'
.color(
'reset'
),
$self
->memString(
$proc
->rss,
'rss'
)
]);
push
(
@data
, [
color(
$self
->{varColor} ).
'Time'
.color(
'reset'
),
$self
->timeString(
$proc
->
time
)
]);
push
(
@data
, [
color(
$self
->{varColor} ).
'Info'
.color(
'reset'
),
color(
$self
->{valColor} ).
$self
->{is}->info(
$proc
).color(
'reset'
)
]);
foreach
my
$key
(
@proc_keys
){
if
(
$proc
->{
$key
} !~ /^$/ ){
my
$print_it
=1;
my
$value
;
if
(
(
$key
=~ /
time
$/ ) &&
(
$proc
->{
$key
} =~ /\.0*$/ ) &&
(
$self
->{zero_time} )
){
$print_it
=0;
}
elsif
(
$key
=~ /
time
$/ ){
$value
=
$self
->timeString(
$proc
->{
$key
} );
}
if
(
$key
=~ /^environ$/ ){
$value
=
join
( color(
$self
->{environ} ).
', '
.color(
'reset'
) , @{
$proc
->{environ} } );
if
( !
defined
(
$value
) ){
$value
=
''
;
}
}
if
(
(
$key
=~ /flt$/ ) &&
(
$proc
->{
$key
} eq 0 ) &&
(
$self
->{zero_flt} )
){
$print_it
=0;
}
if
(
$key
=~ /^start$/ ){
$value
=
$self
->startString(
$proc
->{start} );
}
if
( !
defined
(
$value
) ){
$value
=color(
$self
->{valColor} ).
$proc
->{
$key
}.color(
'reset'
);
}
if
(
$print_it
){
push
(
@data
, [
color(
$self
->{varColor} ).
$key
.color(
'reset'
),
$value
,
]);
}
}
}
if
(
$proc
->{cmndline} !~ /^$/ ){
push
(
@data
, [
color(
$self
->{varColor} ).
'Cmndline'
.color(
'reset'
),
color(
$self
->{processColor} ).
$proc
->{cmndline}.color(
'reset'
)
]);
}
my
$open_files
=
''
;
my
$pid
=
$proc
->pid;
my
$output_raw
=`lsof -n -l -P -p
$pid
`;
if
(
( $? eq 0 ) ||
(
( $^O =~ /linux/ ) &&
( $? eq 256 )
)
){
my
$ftb
= Text::ANSITable->new;
$ftb
->border_style(
'Default::none_ascii'
);
$ftb
->color_theme(
'Default::no_color'
);
$ftb
->show_header(1);
$ftb
->set_column_style(0,
pad
=> 0);
$ftb
->set_column_style(1,
pad
=> 1);
$ftb
->set_column_style(2,
pad
=> 0);
$ftb
->set_column_style(3,
pad
=> 1);
$ftb
->set_column_style(4,
pad
=> 0);
$ftb
->columns([
color(
$self
->{varColor} ).
'FD'
.color(
'reset'
),
color(
$self
->{varColor} ).
'TYPE'
.color(
'reset'
),
color(
$self
->{varColor} ).
'DEVICE'
.color(
'reset'
),
color(
$self
->{varColor} ).
'SIZE/OFF'
.color(
'reset'
),
color(
$self
->{varColor} ).
'NODE'
.color(
'reset'
),
color(
$self
->{varColor} ).
'NAME'
.color(
'reset'
)
]);
my
@fdata
;
my
%rw_filehandles
;
my
%r_filehandles
;
my
%w_filehandles
;
my
%mem_filehandles
;
my
@lines
=
split
(/\n/,
$output_raw
);
my
$line_int
=1;
while
(
defined
(
$lines
[
$line_int
] ) ){
my
$line
=
substr
$lines
[
$line_int
], 10;
my
@line_split
=
split
(/[\ \t]+/,
$line
);
if
( !
defined
(
$line_split
[7] )){
$line_split
[7]=
''
;
}
my
$dont_add
=0;
if
(
(
$line_split
[3] =~ /^IPv/ ) ||
(
(
$line_split
[2] =~ /^txt$/ ) &&
( !
$self
->{txt} )
) ||
(
(
$line_split
[3] =~ /^[Pp][Ii][Pp][Ee]$/ ) &&
( !
$self
->{
pipe
} )
) ||
(
(
$line_split
[3] =~ /^[Uu][Nn][Ii][Xx]$/ ) &&
( !
$self
->{unix} )
) ||
(
(
$line_split
[3] =~ /^[Ff][Ii][Ff][Oo]$/ ) &&
( !
$self
->{fifo} )
) ||
(
(
$line_split
[3] =~ /^[Rr][Ee][Gg]$/ ) &&
(
(
$line_split
[7] =~ /\.so$/ ) ||
(
$line_split
[7] =~ /\.so\.[0-9]$/ ) ||
(
$line_split
[7] =~ /\.so\.[0-9]+\.[0-9]+$/ ) ||
(
$line_split
[7] =~ /\.so\.[0-9]+\.[0-9]+\.[0-9]+$/ ) ||
(
$line_split
[7] =~ /\.jar$/ )
) &&
( !
$self
->{memreglib} )
) ||
(
(
$line_split
[3] =~ /^a\_inode$/ ) &&
( !
$self
->{a_inode} )
) ||
(
(
$line_split
[3] =~ /^[Vv][Rr][Ee][Gg]$/ ) &&
(
$line_split
[7] =~ /^\/$/ ) &&
( !
$self
->{vregroot} )
)
){
$dont_add
=1;
}
my
$name
= color(
$self
->{file_colors}[5] ).
$line_split
[7].color(
'reset'
);
if
(
( !
$self
->{dont_dedup} ) &&
( !
$dont_add
)
){
if
(
(
$line_split
[3] =~ /[Vv][Rr][Ee][Gg]/ ) ||
(
$line_split
[3] =~ /[Rr][Ee][Gg]/ ) ||
(
$line_split
[3] =~ /[Vv][Dd][Ii][Dd]/ ) ||
(
$line_split
[3] =~ /[Vv][Cc][Hh][Rr]/ )
) {
if
(
(
$line_split
[2] =~ /u/ ) ||
(
$line_split
[2] =~ /rw/ ) ||
(
$line_split
[2] =~ /wr/ )
) {
if
(!
defined
(
$rw_filehandles
{
$name
} ) ) {
$rw_filehandles
{
$name
} = 1;
}
else
{
$rw_filehandles
{
$name
}++;
}
}
elsif
(
(
$line_split
[2] !~ /u/ ) ||
(
$line_split
[2] =~ /r/ )
) {
if
(!
defined
(
$r_filehandles
{
$name
} ) ) {
$r_filehandles
{
$name
} = 1;
}
else
{
$r_filehandles
{
$name
}++;
}
}
elsif
(
(
$line_split
[2] !~ /u/ ) ||
(
$line_split
[2] =~ /w/ )
) {
if
(!
defined
(
$w_filehandles
{
$name
} ) ) {
$w_filehandles
{
$name
} = 1;
}
else
{
$w_filehandles
{
$name
}++;
}
}
elsif
(
(
$line_split
[2] =~ /mem/ )
){
if
(!
defined
(
$mem_filehandles
{
$name
} ) ) {
$mem_filehandles
{
$name
} = 1;
}
else
{
$mem_filehandles
{
$name
}++;
}
}
}
}
if
( !
$dont_add
) {
push
(
@fdata
, [
color(
$self
->{file_colors}[0] ).
$line_split
[2].color(
'reset'
),
color(
$self
->{file_colors}[1] ).
$line_split
[3].color(
'reset'
),
color(
$self
->{file_colors}[2] ).
$line_split
[4].color(
'reset'
),
color(
$self
->{file_colors}[3] ).
$line_split
[5].color(
'reset'
),
color(
$self
->{file_colors}[4] ).
$line_split
[6].color(
'reset'
),
$name
,
]);
}
$line_int
++;
}
my
@final_fdata
;
if
( !
$self
->{dont_dedup} ){
my
%rw_dedup
;
my
%r_dedup
;
my
%w_dedup
;
my
%mem_dedup
;
foreach
my
$line
(
@fdata
){
if
(
(
$line
->[1] =~ /[Vv][Rr][Ee][Gg]/ ) ||
(
$line
->[1] =~ /[Rr][Ee][Gg]/ ) ||
(
$line
->[1] =~ /[Vv][Dd][Ii][Dd]/ ) ||
(
$line
->[1] =~ /[Vv][Cc][Hh][Rr]/ )
){
my
$add_line
=1;
if
(
(
$line
->[0] =~ /u/ ) ||
(
$line
->[0] =~ /rw/ ) ||
(
$line
->[0] =~ /wr/ )
) {
if
(
defined
(
$rw_dedup
{
$line
->[5] } ) ){
$add_line
=0;
}
else
{
if
(
$rw_filehandles
{
$line
->[5] } > 1){
$line
->[0]=
$line
->[0].
'+'
;
}
$rw_dedup
{
$line
->[5] } = 1;
}
}
elsif
(
(
$line
->[0] !~ /u/ ) ||
(
$line
->[0] =~ /r/ )
) {
if
(
defined
(
$r_dedup
{
$line
->[5] } ) ){
$add_line
=0;
}
else
{
if
(
$r_filehandles
{
$line
->[5] } > 1){
$line
->[0]=
$line
->[0].
'+'
;
}
$r_dedup
{
$line
->[5] } = 1;
}
}
elsif
(
(
$line
->[0] !~ /u/ ) ||
(
$line
->[0] =~ /w/ )
) {
if
(
defined
(
$w_dedup
{
$line
->[5] } ) ){
$add_line
=0;
}
else
{
if
(
$w_filehandles
{
$line
->[5] } > 1){
$line
->[0]=
$line
->[0].
'+'
;
}
$w_dedup
{
$line
->[5] } = 1;
}
}
elsif
(
(
$line
->[0] =~ /mem/ )
){
if
(
$mem_filehandles
{
$line
->[5] } > 1){
$line
->[0]=
$line
->[0].
'+'
;
}
$mem_dedup
{
$line
->[5] } = 1;
}
if
(
$add_line
){
push
(
@final_fdata
, [
$line
->[0],
$line
->[1],
$line
->[2],
$line
->[3],
$line
->[4],
$line
->[5],
]);
}
}
else
{
push
(
@final_fdata
, \@{
$line
} );
}
}
$ftb
->add_rows( \
@final_fdata
);
}
else
{
$ftb
->add_rows( \
@fdata
);
}
$open_files
=
$ftb
->draw;
}
my
$netstat
=
''
;
my
@filters
=(
{
type
=>
'PID'
,
invert
=>0,
args
=>{
pids
=>[
$proc
->pid],
}
}
);
my
$ptr
=1;
if
(
$self
->{dont_resolv} ){
$ptr
=0;
}
my
$ncnetstat
=Net::Connection::ncnetstat->new(
{
ptr
=>
$ptr
,
command
=>0,
command_long
=>0,
wchan
=>0,
pct_show
=>0,
no_pid_user
=>1,
match
=>{
checks
=>\
@filters
,
}
}
);
$netstat
=
$ncnetstat
->run;
$tb
->add_rows( \
@data
);
if
(
$first
){
$first
=0;
$toReturn
=
$toReturn
.
$tb
->draw.
$open_files
.
$netstat
;
}
else
{
$toReturn
=
$toReturn
.
$open_files
.
"\n\n"
.
$tb
->draw;
}
}
return
$toReturn
;
}
sub
timeString{
my
$self
=
$_
[0];
my
$time
=
$_
[1];
if
( $^O =~ /^linux$/ ) {
$time
=
$time
/1000000;
}
my
$hours
=0;
if
(
$time
>= 3600 ) {
$hours
=
$time
/ 3600;
}
my
$loSeconds
=
$time
% 3600;
my
$minutes
=0;
if
(
$time
>= 60 ) {
$minutes
=
$loSeconds
/ 60;
}
my
$seconds
=
$loSeconds
% 60;
$hours
=~s/\..*//;
$minutes
=~s/\..*//;
my
$toReturn
=
''
;
if
(
$hours
== 0 ) {
}
elsif
(
$hours
>= 10
) {
$toReturn
=color(
$self
->{timeColors}->[3]).
$hours
.
':'
;
}
else
{
$toReturn
=color(
$self
->{timeColors}->[2]).
$hours
.
':'
;
}
if
(
(
$hours
> 0 ) ||
(
$minutes
> 0 )
) {
$toReturn
=
$toReturn
.color(
$self
->{timeColors}->[1] ).
$minutes
.
':'
;
}
$toReturn
=
$toReturn
.color(
$self
->{timeColors}->[0] ).
$seconds
.color(
'reset'
);
return
$toReturn
;
}
sub
memString{
my
$self
=
$_
[0];
my
$mem
=
$_
[1];
my
$type
=
$_
[2];
my
$toReturn
=
''
;
if
(
$mem
<
'10000'
) {
$toReturn
=color(
$self
->{
$type
.
'Colors'
}[0] ).
$mem
;
}
elsif
(
(
$mem
>=
'10000'
) &&
(
$mem
<
'1000000'
)
) {
$mem
=
$mem
/1000;
$toReturn
=color(
$self
->{
$type
.
'Colors'
}[0] ).
$mem
.
color(
$self
->{
$type
.
'Colors'
}[3] ).
'k'
;
}
elsif
(
(
$mem
>=
'1000000'
) &&
(
$mem
<
'1000000000'
)
) {
$mem
=(
$mem
/1000)/1000;
$mem
=
sprintf
(
'%.3f'
,
$mem
);
my
@mem_split
=
split
(/\./,
$mem
);
$toReturn
=color(
$self
->{
$type
.
'Colors'
}[1] ).
$mem_split
[0].
'.'
.color(
$self
->{
$type
.
'Colors'
}[0] ).
$mem_split
[1].
color(
$self
->{
$type
.
'Colors'
}[3] ).
'M'
;
}
elsif
(
$mem
>=
'1000000000'
) {
$mem
=((
$mem
/1000)/1000)/1000;
$mem
=
sprintf
(
'%.3f'
,
$mem
);
my
@mem_split
=
split
(/\./,
$mem
);
$toReturn
=color(
$self
->{
$type
.
'Colors'
}[2] ).
$mem_split
[0].
'.'
.color(
$self
->{
$type
.
'Colors'
}[1] ).
$mem_split
[1].
color(
$self
->{
$type
.
'Colors'
}[3] ).
'G'
;
}
return
$toReturn
.color(
'reset'
);
}
sub
startString{
my
$self
=
$_
[0];
my
$startTime
=
$_
[1];
my
(
$sec
,
$min
,
$hour
,
$mday
,
$mon
,
$year
,
$wday
,
$yday
,
$isdst
) =
localtime
(
$startTime
);
my
(
$csec
,
$cmin
,
$chour
,
$cmday
,
$cmon
,
$cyear
,
$cwday
,
$cyday
,
$cisdst
) =
localtime
(
time
);
$year
+= 1900;
$cyear
+= 1900;
$mon
+= 1;
$cmon
+= 1;
if
(
$year
ne
$cyear
) {
return
$year
.
sprintf
(
'%02d'
,
$mon
).
sprintf
(
'%02d'
,
$mday
).
'-'
.
sprintf
(
'%02d'
,
$hour
).
':'
.
sprintf
(
'%02d'
,
$min
);
}
if
(
$mon
ne
$cmon
) {
return
sprintf
(
'%02d'
,
$mon
).
sprintf
(
'%02d'
,
$mday
).
'-'
.
sprintf
(
'%02d'
,
$hour
).
':'
.
sprintf
(
'%02d'
,
$min
);
}
if
(
$mday
ne
$cmday
) {
return
sprintf
(
'%02d'
,
$mday
).
'-'
.
sprintf
(
'%02d'
,
$hour
).
':'
.
sprintf
(
'%02d'
,
$min
);
}
return
sprintf
(
'%02d'
,
$hour
).
':'
.
sprintf
(
'%02d'
,
$min
);
}
sub
nextColor{
my
$self
=
$_
[0];
my
$color
;
if
(
defined
(
$self
->{colors}[
$self
->{nextColor} ] ) ) {
$color
=
$self
->{colors}[
$self
->{nextColor} ];
$self
->{nextColor}++;
}
else
{
$self
->{nextColor}=0;
$color
=
$self
->{colors}[
$self
->{nextColor} ];
$self
->{nextColor}++;
}
return
$color
;
}
1;