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:
parent
c57d0a13ad
commit
f721e832af
|
@ -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;
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue