woot! lots more working now... including the search bits

git-svn-id: svn://127.0.0.1/Perl/Proc-ProcessTable-Colorizer/trunk@965 0c1c3402-1be1-de11-8092-0022686faf23
This commit is contained in:
Zane C. B-H 2017-10-13 09:26:55 +00:00
parent c57d0a13ad
commit f721e832af
2 changed files with 317 additions and 136 deletions

View File

@ -36,9 +36,11 @@ sub main::HELP_MESSAGE {
#gets the options
my %opts=();
getopts('', \%opts);
getopts('p:u:', \%opts);
use Proc::ProcessTable::Colorizer;
my $cps = Proc::ProcessTable::Colorizer->new;
$cps->searchSet( $opts{p} );
$cps->userSet( $opts{p} );
print $cps->colorize;

View File

@ -30,8 +30,8 @@ our $VERSION = '0.0.0';
use Proc::ProcessTable::Colorizer;
my $cps = Proc::ProcessTable::Colorizer->new();
...
my $cps = Proc::ProcessTable::Colorizer->new;
print $cps->colorize;
This module uses L<Error::Helper> for error reporting.
@ -81,9 +81,13 @@ sub new {
'proc',
],
header=>1,
search=>undef,
resolveUser=>1,
nextColor=>0,
showIdle=>0,
proc_search=>undef,
user_search=>undef,
self_ignore=>2,
};
bless $self;
return $self;
@ -91,6 +95,12 @@ sub new {
=head2 colorize
This colorizes it and returns a setup Text::Table object with everything already setup.
use Proc::ProcessTable::Colorizer;
my $cps = Proc::ProcessTable::Colorizer->new;
print $cps->colorize;
=cut
sub colorize{
@ -189,13 +199,28 @@ sub colorize{
#set the proc value
if ( $cmndline =~ /^$/ ){
#kernel proc
$values{'proc'}='['.$fname.']';
if ( $fname eq 'idle' ){
$values{'idle'}=1;
my $kernel_proc=1; #just assuming yet, unless it is otherwise
#may possible be a zombie, run checks for on FreeBSD
if ($^O =~ /bsd/){
my $bproc=BSD::Process::info( $proc->pid );
$kernel_proc=$bproc->{kthread};
}
#need to find something similar as above for Linux
#
if ( $kernel_proc ){
$values{'proc'}='['.$fname.']';
if ( $fname eq 'idle' ){
$values{'idle'}=1;
}
}else{
#most likely a zombie
$values{'proc'}=$fname;
}
}else{
$values{'proc'}=$fname;
$values{'proc'}=$cmndline;
}
}elsif(
$field eq 'info'
@ -215,8 +240,6 @@ sub colorize{
$values{is_stopped}=$bproc->{stat_4};
$values{posix_advisory_lock}=$bproc->{advlock};
#use Data::Dumper;
#print Dumper( $bproc );
}
}else{
@ -260,11 +283,13 @@ sub colorize{
} @procs;
@procs=reverse(@procs);
#put together the colored colums, minus the proc column which will be done later
my @proc_column;
foreach my $proc (@procs){
my @line;
$self->nextColorReset;
my $show=1;
my $show=0;
#checks if it is the idle proc and if it should show it
if (
@ -272,9 +297,40 @@ sub colorize{
( ! $self->{showIdle} )
){
$show = 0;
}else{
my $required_hits=0; #number of hits required to print it
my $hits=0; #default to zero so we print it unless we increment this for a search item
#checks if we need to do a proc search
my $proc_search=$self->{proc_search};
if ( defined( $proc_search ) ){
$required_hits++;
#cehck if the cmndline or fname matches
if ( $proc->{proc} =~ /$proc_search/ ){
$hits++;
}
}
my $self_ignore=$self->{self_ignore};
if (
( $self_ignore == 1 ) &&
( $proc->{pid} == $$ )
){
$hits++;
}elsif(
( $required_hits > 0 ) &&
( $self_ignore == 2 ) &&
( $proc->{pid} == $$ )
){
$hits++;
}
if ( $required_hits == $hits ){
$show=1;
}
}
if (
( $show )
){
@ -284,149 +340,146 @@ sub colorize{
if ( defined( $proc->{$field} ) ){
$item=$proc->{$field};
}
if ( $field eq 'start' ){
$item=$self->startString($item);
}
if (
( $field eq 'uid' ) &&
$self->{resolveUser}
){
$item=getpwuid($item);
}
#colorizes it
if ( $field eq 'time' ){
$item=$self->timeString($item);
}elsif( $field eq 'proc' ){
$item=color($self->processColorGet).$item;
}elsif( $field eq 'info'){
my $left=$proc->{state};
if (
$left eq 'sleep'
){
$left='S';
}elsif(
$left eq 'zombie'
){
$left='Z';
}elsif(
$left eq 'wait'
){
$left='W';
}elsif(
$left eq 'run'
){
$left='R';
#we will add proc later once we know the size of the table
if ($field ne 'proc'){
if ( $field eq 'start' ){
$item=$self->startString($item);
}
#checks if it is swapped out
if (
( $proc->{state} ne 'zombie' ) &&
( $field eq 'uid' ) &&
$self->{resolveUser}
){
$item=getpwuid($item);
}
#colorizes it
if ( $field eq 'time' ){
$item=$self->timeString($item);
}elsif( $field eq 'proc' ){
$item=color($self->processColorGet).$item;
}elsif( $field eq 'info'){
my $left=$proc->{state};
if (
$left eq 'sleep'
){
$left='S';
}elsif(
$left eq 'zombie'
){
$left='Z';
}elsif(
$left eq 'wait'
){
$left='W';
}elsif(
$left eq 'run'
){
$left='R';
}
#checks if it is swapped out
if (
( $proc->{state} ne 'zombie' ) &&
( $proc->{rss} == '0' )
){
$left=$left.'O';
}
#waiting to exit
if (
){
$left=$left.'O';
}
#waiting to exit
if (
( defined( $proc->{working_on_exiting} ) ) &&
$proc->{working_on_exiting}
){
$left=$left.'E';
}
$proc->{working_on_exiting}
){
$left=$left.'E';
}
#session leader
if (
( defined( $proc->{is_session_leader} ) ) &&
$proc->{is_session_leader}
){
$left=$left.'s';
}
#checks to see if any sort of locks are present
if (
( defined( $proc->{is_locked} ) || defined( $proc->{posix_advisory_lock} ) )&&
( $proc->{is_locked} || $proc->{posix_advisory_lock} )
){
$left=$left.'L';
}
#session leader
if (
( defined( $proc->{is_session_leader} ) ) &&
$proc->{is_session_leader}
){
$left=$left.'s';
}
#checks to see if any sort of locks are present
if (
( defined( $proc->{is_locked} ) || defined( $proc->{posix_advisory_lock} ) )&&
( $proc->{is_locked} || $proc->{posix_advisory_lock} )
){
$left=$left.'L';
}
#checks to see if has a controlling terminal
if (
( defined( $proc->{has_controlling_terminal} ) ) &&
$proc->{has_controlling_terminal}
){
$left=$left.'+';
#checks to see if has a controlling terminal
if (
( defined( $proc->{has_controlling_terminal} ) ) &&
$proc->{has_controlling_terminal}
){
$left=$left.'+';
}
#if it is being forked
if (
( defined( $proc->{is_being_forked} ) ) &&
$proc->{is_being_forked}
){
$left=$left.'F';
}
#checks if it knows it is being traced
if (
( defined( $proc->{traced_by_debugger} ) ) &&
$proc->{traced_by_debugger}
){
$left=$left.'X';
}
$item=color($self->nextColor).$left.' '.color($self->nextColor).$proc->{wchan};
}else{
$item=color($self->nextColor).$item;
}
#if it is being forked
if (
( defined( $proc->{is_being_forked} ) ) &&
$proc->{is_being_forked}
){
$left=$left.'F';
}
#checks if it knows it is being traced
if (
( defined( $proc->{traced_by_debugger} ) ) &&
$proc->{traced_by_debugger}
){
$left=$left.'X';
}
$item=color($self->nextColor).$left.' '.color($self->nextColor).$proc->{wchan};
push( @line, $item.color('reset') );
}else{
$item=color($self->nextColor).$item;
}
push( @line, $item.color('reset') );
push( @proc_column, $item );
}
}
push( @colored, \@line );
}
}
#get table width info
my $tb = Text::Table->new;
return $tb->load( @colored );
}
$tb->load( @colored );
my $width=$tb->width;
my ($columns, $rows) = Term::Size::chars *STDOUT{IO};
$tb->clear;
=head2 startString
#add 120 as Text::Table appears to be off by that much
$columns=$columns+128;
Generates a short time string based on the supplied unix time.
#this is
my $procwidth=$columns-$width;
=cut
#process each colored item and shove the proc info in
my $colored_int=1;
my $proc_column_int=0;
while ( defined( $colored[$colored_int] ) ){
my $item=$proc_column[$proc_column_int];
#remove all the newlines
$item=~s/\n//g;
sub startString{
my $self=$_[0];
my $startTime=$_[1];
$self->errorblank;
$item=substr( $item, 0, $procwidth);
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($startTime);
my ($csec,$cmin,$chour,$cmday,$cmon,$cyear,$cwday,$cyday,$cisdst) = localtime(time);
push( @{$colored[$colored_int]}, $item );
#add the required stuff to make this sane
$year += 1900;
$cyear += 1900;
$mon += 1;
$cmon += 1;
$proc_column_int++;
$colored_int++;
}
#find the most common one and return it
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);
}
#just return this for anything less
return sprintf('%02d', $hour).':'.sprintf('%02d', $min);
return $tb->load( @colored );
}
=head2 fields
@ -545,6 +598,130 @@ sub processColorGet{
return $self->{processColor};
}
=head2 searchGet
This returns the search string value that will be used
for matching the proc column.
The return is undefined if one is not set.
my $search_regex=$cps->searchGet;
if ( defined( $search_regex ) ){
print "search regex: ".$search_regex."\n";
}else{
print "No search regex.\n";
}
=cut
sub searchGet{
my $self=$_[0];
$self->errorblank;
return $self->{proc_search};
}
=head2 searchSet
This sets the proc column search regex to use.
If set to undef(the default), then it will show all procs.
#shows everything
$cps->searchSet( undef );
#search for only those matching musicpd
$cps->seearchSet( 'musicpd' );
#search for those that match /[Zz]whatever/
$cps->searchSet( '[Zz]whatever' );
=cut
sub searchSet{
my $self=$_[0];
my $proc_search=$_[1];
$self->errorblank;
$self->{proc_search}=$proc_search;
return 1;
}
=head2 searchGet
This returns the search string value that will be used
for matching the proc column.
The return is undefined if one is not set.
my $search_regex=$cps->searchGet;
if ( defined( $search_regex ) ){
print "search regex: ".$search_regex."\n";
}else{
print "No search regex.\n";
}
=cut
sub selfIgnoreGet{
my $self=$_[0];
$self->errorblank;
return $self->{self_ignore};
}
=head2 searchSet
=cut
sub selfIgnoreSet{
my $self=$_[0];
my $self_ignore=$_[1];
$self->errorblank;
$self->{self_ignore}=$self_ignore;
return 1;
}
=head2 startString
Generates a short time string based on the supplied unix time.
=cut
sub startString{
my $self=$_[0];
my $startTime=$_[1];
$self->errorblank;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($startTime);
my ($csec,$cmin,$chour,$cmday,$cmon,$cyear,$cwday,$cyday,$cisdst) = localtime(time);
#add the required stuff to make this sane
$year += 1900;
$cyear += 1900;
$mon += 1;
$cmon += 1;
#find the most common one and return it
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);
}
#just return this for anything less
return sprintf('%02d', $hour).':'.sprintf('%02d', $min);
}
=head2 timeColorsGet
my $timeColors=$cps->timeColorsGet;
@ -608,7 +785,9 @@ sub timeString{
$toReturn=$toReturn.color( $colors->[1] ). $minutes.':';
}
return $toReturn.color( $colors->[0] ). $seconds ;
$toReturn=$toReturn.color( $colors->[0] ).$seconds;
return $toReturn;
}
=head1 COLORS