1669 lines
33 KiB
Perl
1669 lines
33 KiB
Perl
package Proc::ProcessTable::Colorizer;
|
|
|
|
use 5.006;
|
|
use strict;
|
|
use warnings;
|
|
use base 'Error::Helper';
|
|
use Proc::ProcessTable;
|
|
use Term::ANSIColor;
|
|
use Text::Table;
|
|
use Term::Size;
|
|
|
|
if ( $^O =~ /bsd/ ){
|
|
require BSD::Process;
|
|
}
|
|
|
|
=head1 NAME
|
|
|
|
Proc::ProcessTable::Colorizer - Like ps, but with colored columns and enhnaced functions for searching.
|
|
|
|
=head1 VERSION
|
|
|
|
Version 0.1.0
|
|
|
|
=cut
|
|
|
|
our $VERSION = '0.1.0';
|
|
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Proc::ProcessTable::Colorizer;
|
|
|
|
my $cps = Proc::ProcessTable::Colorizer->new;
|
|
print $cps->colorize;
|
|
|
|
This module uses L<Error::Helper> for error reporting.
|
|
|
|
As of right now this module is not really user friend and will likely be going through lots of changes as it grows.
|
|
|
|
Linux is also not as well supported given the limitations of Proc::ProcessTable and there is nothig similar to
|
|
L<BSD::Process> for Linux.
|
|
|
|
=head1 METHODS
|
|
|
|
=head2 new
|
|
|
|
Creates a new object. This method will never error.
|
|
|
|
my $cps=Proc::ProcessTable::Colorizer->new;
|
|
|
|
=cut
|
|
|
|
sub new {
|
|
my $self={
|
|
perror=>undef,
|
|
error=>undef,
|
|
errorString=>'',
|
|
errorExtra=>{
|
|
1=>'badTimeString',
|
|
2=>'badPctcpuString',
|
|
},
|
|
colors=>[
|
|
'BRIGHT_YELLOW',
|
|
'BRIGHT_CYAN',
|
|
'BRIGHT_MAGENTA',
|
|
'BRIGHT_BLUE'
|
|
],
|
|
timeColors=>[
|
|
'GREEN',
|
|
'BRIGHT_GREEN',
|
|
'RED',
|
|
'BRIGHT_RED'
|
|
],
|
|
processColor=>'WHITE',
|
|
fields=>[
|
|
'pid',
|
|
'uid',
|
|
'pctcpu',
|
|
'pctmem',
|
|
'size',
|
|
'rss',
|
|
'info',
|
|
'nice',
|
|
'start',
|
|
'time',
|
|
'proc',
|
|
],
|
|
header=>1,
|
|
search=>undef,
|
|
resolveUser=>1,
|
|
nextColor=>0,
|
|
showIdle=>0,
|
|
proc_search=>undef,
|
|
user_search=>[],
|
|
wait_search=>[],
|
|
self_ignore=>2,
|
|
zombie_search=>0,
|
|
swapped_out_search=>0,
|
|
time_search=>[],
|
|
pctcpu_search=>[],
|
|
};
|
|
bless $self;
|
|
return $self;
|
|
}
|
|
|
|
=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{
|
|
my $self=$_[0];
|
|
$self->errorblank;
|
|
|
|
#the feilds to use
|
|
my $fields=$self->fieldsGet;
|
|
|
|
#array of colored items
|
|
my @colored;
|
|
|
|
#
|
|
my $fieldInt=0;
|
|
my $header;
|
|
if ( $self->{header} ){
|
|
my @header;
|
|
while ( defined( $fields->[$fieldInt] ) ){
|
|
my $field=color('underline white');
|
|
|
|
if ( $fields->[$fieldInt] eq 'pid' ){
|
|
$field=$field.'PID';
|
|
}elsif( $fields->[$fieldInt] eq 'uid' ){
|
|
$field=$field.'User';
|
|
}elsif( $fields->[$fieldInt] eq 'pctcpu' ){
|
|
$field=$field.'CPU%';
|
|
}elsif( $fields->[$fieldInt] eq 'pctmem' ){
|
|
$field=$field.'Mem%';
|
|
}elsif( $fields->[$fieldInt] eq 'size' ){
|
|
$field=$field.'VM Size';
|
|
}elsif( $fields->[$fieldInt] eq 'rss' ){
|
|
$field=$field.'RSS';
|
|
}elsif( $fields->[$fieldInt] eq 'proc' ){
|
|
$field=$field.'Command';
|
|
}else{
|
|
$field=$field.ucfirst($fields->[$fieldInt]);
|
|
}
|
|
|
|
push( @header, $field.color('reset') );
|
|
|
|
$fieldInt++;
|
|
}
|
|
|
|
push( @colored, \@header );
|
|
}
|
|
|
|
#get the process table
|
|
my $pt=Proc::ProcessTable->new;
|
|
|
|
#an array of procs
|
|
my @procs;
|
|
|
|
#goes through it all and gathers the information
|
|
foreach my $proc ( @{$pt->table} ){
|
|
|
|
my $bproc;
|
|
if ($^O =~ /bsd/){
|
|
$bproc=BSD::Process::info( $proc->pid );
|
|
}
|
|
|
|
#process the requested fields
|
|
$fieldInt=0;
|
|
my %values;
|
|
while ( defined( $fields->[$fieldInt] ) ){
|
|
my $field=$fields->[$fieldInt];
|
|
|
|
if (
|
|
($^O =~ /bsd/) &&
|
|
( $field =~ /pctcpu/ )
|
|
){
|
|
my $pctcpu=$bproc->{pctcpu};
|
|
|
|
if ( ! defined( $pctcpu ) ){
|
|
$values{pctcpu}=0
|
|
}else{
|
|
my $fscale=`/sbin/sysctl -a kern.fscale`;
|
|
$fscale=~s/^.*\: //;
|
|
chomp($fscale);
|
|
|
|
$values{pctcpu}= 100 * ( $pctcpu / $fscale );
|
|
}
|
|
}elsif(
|
|
($^O =~ /bsd/) &&
|
|
( $field =~ /pctmem/ )
|
|
){
|
|
my $rss=$bproc->{rssize};
|
|
if ( defined( $rss ) ){
|
|
$rss=$rss*1024*4;
|
|
|
|
my $physmem=`/sbin/sysctl -a hw.physmem`;
|
|
chomp($physmem);
|
|
$physmem=~s/^.*\: //;
|
|
|
|
$values{pctmem}=($rss / $physmem)*100;
|
|
}else{
|
|
$values{pctmem}=0;
|
|
}
|
|
}elsif(
|
|
($^O =~ /bsd/) &&
|
|
( $field =~ /size/ )
|
|
){
|
|
$values{size}=$bproc->{size};
|
|
}elsif(
|
|
($^O =~ /bsd/) &&
|
|
( $field =~ /rss/ )
|
|
){
|
|
$values{rss}=$proc->{rssize};
|
|
if (!defined $values{rss} ){
|
|
$values{rss}=0;
|
|
}else{
|
|
#not sure why this needs done :/
|
|
$values{rss}=$values{rss}*4;
|
|
}
|
|
}elsif(
|
|
$field eq 'proc'
|
|
){
|
|
my $fname=$proc->fname;
|
|
my $cmndline=$proc->cmndline;
|
|
|
|
#save it for possible future use
|
|
$values{fname}=$fname;
|
|
$values{cmndline}=$cmndline;
|
|
|
|
#set the proc value
|
|
if ( $cmndline =~ /^$/ ){
|
|
my $kernel_proc=1; #just assuming yet, unless it is otherwise
|
|
|
|
#may possible be a zombie, run checks for on FreeBSD
|
|
if ($^O =~ /bsd/){
|
|
$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{
|
|
if ( $cmndline =~ /^su *$/ ){
|
|
$values{'proc'}=$cmndline.'('.$fname.')';
|
|
}else{
|
|
$values{'proc'}=$cmndline;
|
|
}
|
|
}
|
|
}elsif(
|
|
$field eq 'info'
|
|
){
|
|
$values{wchan}=$proc->wchan;
|
|
$values{state}=$proc->state;
|
|
|
|
if ($^O =~ /bsd/){
|
|
$values{controlling_tty_active}=$bproc->{isctty};
|
|
$values{is_session_leader}=$bproc->{issleader};
|
|
$values{is_being_forked}=$bproc->{stat_1};
|
|
$values{working_on_exiting}=$bproc->{wexit};
|
|
$values{has_controlling_terminal}=$bproc->{controlt};
|
|
$values{is_locked}=$bproc->{locked};
|
|
$values{traced_by_debugger}=$bproc->{traced};
|
|
$values{is_stopped}=$bproc->{stat_4};
|
|
$values{posix_advisory_lock}=$bproc->{advlock};
|
|
}
|
|
|
|
}else{
|
|
$values{$field}=$proc->$field;
|
|
}
|
|
|
|
|
|
$fieldInt++;
|
|
}
|
|
|
|
if ( ! defined( $values{pctmem} ) ){
|
|
$values{pctmem} = 0;
|
|
}
|
|
if ( ! defined( $values{pctcpu} ) ){
|
|
$values{pctcpu} = 0;
|
|
}
|
|
|
|
if ( ! defined( $values{size} ) ){
|
|
$values{size} = 0;
|
|
}
|
|
|
|
$values{pctmem}=sprintf('%.2f', $values{pctmem});
|
|
$values{pctcpu}=sprintf('%.2f', $values{pctcpu});
|
|
|
|
$values{size}=$values{size}/1024;
|
|
|
|
push( @procs, \%values );
|
|
|
|
}
|
|
|
|
#sort by CPU percent and then RAM
|
|
@procs=sort {
|
|
$a->{pctcpu} <=> $b->{pctcpu} or
|
|
$a->{pctmem} <=> $b->{pctmem} or
|
|
$a->{rss} <=> $b->{rss} or
|
|
$a->{size} <=> $b->{size} or
|
|
$a->{time} <=> $b->{time}
|
|
} @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=0;
|
|
|
|
#checks if it is the idle proc and if it should show it
|
|
if (
|
|
defined ( $proc->{idle} ) &&
|
|
( ! $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++;
|
|
}
|
|
}
|
|
|
|
#checks to see if it should ignore its self
|
|
my $self_ignore=$self->{self_ignore};
|
|
if (
|
|
#if it is set to 1
|
|
( $self_ignore == 1 ) &&
|
|
( $proc->{pid} == $$ )
|
|
){
|
|
$required_hits++;
|
|
}elsif(
|
|
#if it is set to 2... we only care if we are doing a search...
|
|
#meaning required hits are greater than zero
|
|
( $required_hits > 0 ) &&
|
|
( $self_ignore == 2 ) &&
|
|
( $proc->{pid} == $$ )
|
|
){
|
|
#increment this so it will always be off by one for this proc, meaning it is ignored
|
|
$required_hits++;
|
|
}
|
|
|
|
#check to see if it needs to search for users
|
|
my $user_search_array=$self->userSearchGet;
|
|
if ( defined( $user_search_array->[0] ) ){
|
|
my $user=getpwuid($proc->{uid});
|
|
$required_hits++;
|
|
my $user_search_int=0;
|
|
my $matched=0;
|
|
#search while we have a user defined and it has not already been matched
|
|
while(
|
|
defined( $user_search_array->[ $user_search_int ] ) &&
|
|
( $matched == 0 )
|
|
){
|
|
my $to_match=$user_search_array->[ $user_search_int ];
|
|
my $to_invert=0;
|
|
if ( $to_match=~ /^\!/ ){
|
|
$to_invert=1;
|
|
$to_match=~s/^\!//;
|
|
}
|
|
|
|
#check if it matches
|
|
if ( $to_invert ){
|
|
if ( $to_match ne $user ){
|
|
$hits++;
|
|
$matched=1;
|
|
}
|
|
}else{
|
|
if ( $to_match eq $user ){
|
|
$hits++;
|
|
$matched=1;
|
|
}
|
|
}
|
|
|
|
$user_search_int++;
|
|
}
|
|
|
|
}
|
|
|
|
#check to see if it needs to search for wait channels
|
|
my $wait_search_array=$self->waitSearchGet;
|
|
if ( defined( $wait_search_array->[0] ) ){
|
|
$required_hits++;
|
|
my $wait_search_int=0;
|
|
my $matched=0;
|
|
#search while we have a wait channel defined and it has not already been matched
|
|
while(
|
|
defined( $wait_search_array->[ $wait_search_int ] ) &&
|
|
( $matched == 0 )
|
|
){
|
|
my $to_match=$wait_search_array->[ $wait_search_int ];
|
|
my $to_invert=0;
|
|
if ( $to_match=~ /^\!/ ){
|
|
$to_invert=1;
|
|
$to_match=~s/^\!//;
|
|
}
|
|
|
|
#check if it matches
|
|
if ( $to_invert ){
|
|
if ( $to_match ne $proc->{wchan} ){
|
|
$hits++;
|
|
$matched=1;
|
|
}
|
|
}else{
|
|
if ( $to_match eq $proc->{wchan} ){
|
|
$hits++;
|
|
$matched=1;
|
|
}
|
|
}
|
|
|
|
$wait_search_int++;
|
|
}
|
|
|
|
}
|
|
|
|
#check to see if it needs to search for CPU time usage
|
|
my $time_search_array=$self->timeSearchGet;
|
|
if ( defined( $time_search_array->[0] ) ){
|
|
$required_hits++;
|
|
my $time_search_int=0;
|
|
my $matched=0;
|
|
#search while we have a CPU time defined and it has not already been matched
|
|
while(
|
|
defined( $time_search_array->[ $time_search_int ] ) &&
|
|
( $matched == 0 )
|
|
){
|
|
my $checked=0;
|
|
my $to_match=$time_search_array->[ $time_search_int ];
|
|
my $time=$proc->{time};
|
|
#checks for less than or equal
|
|
if (
|
|
( $to_match =~ /^\<\=/ ) &&
|
|
( $checked == 0 )
|
|
){
|
|
$checked++;
|
|
$to_match =~ s/^\<\=//;
|
|
if ( $time <= $to_match ){
|
|
$hits++;
|
|
$matched++;
|
|
}
|
|
}
|
|
|
|
#checks for less than
|
|
if (
|
|
( $to_match =~ /^\</ ) &&
|
|
( $checked == 0 )
|
|
){
|
|
$checked++;
|
|
$to_match =~ s/^\<//;
|
|
if ( $time < $to_match ){
|
|
$hits++;
|
|
$matched++;
|
|
}
|
|
}
|
|
|
|
#checks for greater than or equal
|
|
if (
|
|
( $to_match =~ /^\>=/ ) &&
|
|
( $checked == 0 )
|
|
){
|
|
$checked++;
|
|
$to_match =~ s/^\>\=//;
|
|
if ( $time >= $to_match ){
|
|
$hits++;
|
|
$matched++;
|
|
}
|
|
}
|
|
|
|
#checks for greater than
|
|
if (
|
|
( $to_match =~ /^\>/ ) &&
|
|
( $checked == 0 )
|
|
){
|
|
$checked++;
|
|
$to_match =~ s/^\>//;
|
|
if ( $time > $to_match ){
|
|
$hits++;
|
|
$matched++;
|
|
}
|
|
}
|
|
|
|
$time_search_int++;
|
|
}
|
|
|
|
}
|
|
|
|
#check to see if it needs to search for CPU percent
|
|
my $pctcpu_search_array=$self->pctcpuSearchGet;
|
|
if ( defined( $pctcpu_search_array->[0] ) ){
|
|
$required_hits++;
|
|
my $pctcpu_search_int=0;
|
|
my $matched=0;
|
|
#search while we have a CPU usage defined and it has not already been matched
|
|
while(
|
|
defined( $pctcpu_search_array->[ $pctcpu_search_int ] ) &&
|
|
( $matched == 0 )
|
|
){
|
|
my $checked=0;
|
|
my $to_match=$pctcpu_search_array->[ $pctcpu_search_int ];
|
|
my $time=$proc->{pctcpu};
|
|
#checks for less than or equal
|
|
if (
|
|
( $to_match =~ /^\<\=/ ) &&
|
|
( $checked == 0 )
|
|
){
|
|
$checked++;
|
|
$to_match =~ s/^\<\=//;
|
|
if ( $time <= $to_match ){
|
|
$hits++;
|
|
$matched++;
|
|
}
|
|
}
|
|
|
|
#checks for less than
|
|
if (
|
|
( $to_match =~ /^\</ ) &&
|
|
( $checked == 0 )
|
|
){
|
|
$checked++;
|
|
$to_match =~ s/^\<//;
|
|
if ( $time < $to_match ){
|
|
$hits++;
|
|
$matched++;
|
|
}
|
|
}
|
|
|
|
#checks for greater than or equal
|
|
if (
|
|
( $to_match =~ /^\>=/ ) &&
|
|
( $checked == 0 )
|
|
){
|
|
$checked++;
|
|
$to_match =~ s/^\>\=//;
|
|
if ( $time >= $to_match ){
|
|
$hits++;
|
|
$matched++;
|
|
}
|
|
}
|
|
|
|
#checks for greater than
|
|
if (
|
|
( $to_match =~ /^\>/ ) &&
|
|
( $checked == 0 )
|
|
){
|
|
$checked++;
|
|
$to_match =~ s/^\>//;
|
|
if ( $time > $to_match ){
|
|
$hits++;
|
|
$matched++;
|
|
}
|
|
}
|
|
|
|
$pctcpu_search_int++;
|
|
}
|
|
}
|
|
|
|
#check to see if it needs to search for memory percent
|
|
my $pctmem_search_array=$self->pctmemSearchGet;
|
|
if ( defined( $pctmem_search_array->[0] ) ){
|
|
$required_hits++;
|
|
my $pctmem_search_int=0;
|
|
my $matched=0;
|
|
#search while we have a memory usage defined and it has not already been matched
|
|
while(
|
|
defined( $pctmem_search_array->[ $pctmem_search_int ] ) &&
|
|
( $matched == 0 )
|
|
){
|
|
my $checked=0;
|
|
my $to_match=$pctmem_search_array->[ $pctmem_search_int ];
|
|
my $pctmem=$proc->{pctmem};
|
|
#checks for less than or equal
|
|
if (
|
|
( $to_match =~ /^\<\=/ ) &&
|
|
( $checked == 0 )
|
|
){
|
|
$checked++;
|
|
$to_match =~ s/^\<\=//;
|
|
if ( $pctmem <= $to_match ){
|
|
$hits++;
|
|
$matched++;
|
|
}
|
|
}
|
|
|
|
#checks for less than
|
|
if (
|
|
( $to_match =~ /^\</ ) &&
|
|
( $checked == 0 )
|
|
){
|
|
$checked++;
|
|
$to_match =~ s/^\<//;
|
|
if ( $pctmem < $to_match ){
|
|
$hits++;
|
|
$matched++;
|
|
}
|
|
}
|
|
|
|
#checks for greater than or equal
|
|
if (
|
|
( $to_match =~ /^\>=/ ) &&
|
|
( $checked == 0 )
|
|
){
|
|
$checked++;
|
|
$to_match =~ s/^\>\=//;
|
|
if ( $pctmem >= $to_match ){
|
|
$hits++;
|
|
$matched++;
|
|
}
|
|
}
|
|
|
|
#checks for greater than
|
|
if (
|
|
( $to_match =~ /^\>/ ) &&
|
|
( $checked == 0 )
|
|
){
|
|
$checked++;
|
|
$to_match =~ s/^\>//;
|
|
if ( $pctmem > $to_match ){
|
|
$hits++;
|
|
$matched++;
|
|
}
|
|
}
|
|
|
|
$pctmem_search_int++;
|
|
}
|
|
}
|
|
|
|
#show zombie procs
|
|
if ( $self->{zombie_search} ){
|
|
$required_hits++;
|
|
if ( $proc->{state} eq 'zombie' ){
|
|
$hits++;
|
|
}
|
|
}
|
|
|
|
#show swapped out procs
|
|
if ( $self->{swapped_out_search} ){
|
|
$required_hits++;
|
|
if (
|
|
( $proc->{state} ne 'zombie' ) &&
|
|
( $proc->{rss} == '0' )
|
|
){
|
|
$hits++;
|
|
}
|
|
}
|
|
|
|
if ( $required_hits == $hits ){
|
|
$show=1;
|
|
}
|
|
}
|
|
|
|
if (
|
|
( $show )
|
|
){
|
|
|
|
foreach my $field ( @{$fields} ){
|
|
my $item='';
|
|
if ( defined( $proc->{$field} ) ){
|
|
$item=$proc->{$field};
|
|
}
|
|
#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);
|
|
}
|
|
|
|
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';
|
|
}
|
|
|
|
#checks if it is swapped out
|
|
if (
|
|
( $proc->{state} ne 'zombie' ) &&
|
|
( $proc->{rss} == '0' )
|
|
){
|
|
$left=$left.'O';
|
|
}
|
|
|
|
#waiting to exit
|
|
if (
|
|
( defined( $proc->{working_on_exiting} ) ) &&
|
|
$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';
|
|
}
|
|
|
|
#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;
|
|
}
|
|
|
|
push( @line, $item.color('reset') );
|
|
}else{
|
|
push( @proc_column, $item );
|
|
}
|
|
}
|
|
|
|
push( @colored, \@line );
|
|
}
|
|
}
|
|
|
|
#get table width info
|
|
my $tb = Text::Table->new;
|
|
$tb->load( @colored );
|
|
my $width=$tb->width;
|
|
my ($columns, $rows) = Term::Size::chars *STDOUT{IO};
|
|
$tb->clear;
|
|
|
|
#add 120 as Text::Table appears to be off by that much
|
|
$columns=$columns+128;
|
|
|
|
#this is
|
|
my $procwidth=$columns-$width;
|
|
|
|
#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;
|
|
|
|
$item=substr( $item, 0, $procwidth);
|
|
|
|
push( @{$colored[$colored_int]}, $item );
|
|
|
|
$proc_column_int++;
|
|
$colored_int++;
|
|
}
|
|
|
|
return $tb->load( @colored );
|
|
}
|
|
|
|
=head2 fields
|
|
|
|
Gets a hash of possible fields from Proc::ProcessTable as an hash.
|
|
|
|
This is really meant as a internal function.
|
|
|
|
=cut
|
|
|
|
sub fields{
|
|
my $self=$_[0];
|
|
$self->errorblank;
|
|
|
|
my $p=Proc::ProcessTable->new;
|
|
my @fields=$p->fields;
|
|
|
|
my $int=0;
|
|
my %toReturn;
|
|
while( defined($fields[$int]) ){
|
|
$toReturn{$fields[$int]}=1;
|
|
|
|
$int++;
|
|
}
|
|
|
|
return %toReturn;
|
|
}
|
|
|
|
=head2 fieldsGet
|
|
|
|
Gets the currently set fields.
|
|
|
|
Returns a array ref of current fields to be printed.
|
|
|
|
my $fields=$cps->fieldsGet;
|
|
|
|
=cut
|
|
|
|
sub fieldsGet{
|
|
my $self=$_[0];
|
|
$self->errorblank;
|
|
|
|
return $self->{fields};
|
|
}
|
|
|
|
=head2 nextColor
|
|
|
|
Returns the next color.
|
|
|
|
my $nextColor=$cps->nextColor;
|
|
|
|
=cut
|
|
|
|
sub nextColor{
|
|
my $self=$_[0];
|
|
$self->errorblank;
|
|
|
|
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;
|
|
}
|
|
|
|
=head2 nextColor
|
|
|
|
Resets the next color to the first one.
|
|
|
|
my $nextColor=$cps->nextColor;
|
|
|
|
=cut
|
|
|
|
sub nextColorReset{
|
|
my $self=$_[0];
|
|
$self->errorblank;
|
|
|
|
$self->{nextColor}=0;
|
|
|
|
return 1;
|
|
}
|
|
|
|
=head2 fieldsSet
|
|
|
|
Gets the currently set fields.
|
|
|
|
Returns a list of current fields to be printed.
|
|
|
|
my @fields=$cps->fieldsGet;
|
|
|
|
=cut
|
|
|
|
sub fieldsSet{
|
|
my $self=$_[0];
|
|
$self->errorblank;
|
|
|
|
|
|
}
|
|
|
|
=head2 pctcpuSearchGet
|
|
|
|
Returns the current value for the PCT CPU search.
|
|
|
|
The return is a array ref.
|
|
|
|
my $pctcpu_search=$cps->pctcpuSearchGet;
|
|
|
|
=cut
|
|
|
|
sub pctcpuSearchGet{
|
|
my $self=$_[0];
|
|
$self->errorblank;
|
|
|
|
return $self->{pctcpu_search};
|
|
}
|
|
|
|
=head2 pctcpuSearchSetString
|
|
|
|
Search for procs based on the CPU usage.
|
|
|
|
The following equalities are understood.
|
|
|
|
<=
|
|
<
|
|
>
|
|
>=
|
|
|
|
The string may contain multiple values seperated by a comma. Checking will stop after the first hit.
|
|
|
|
If the string is undef, all procs will be shown.
|
|
|
|
#search for procs with less than 60% of CPU usage
|
|
$cps->pctcpuSearchSetString('<60');
|
|
#shows procs with greater than 60% of CPU usage
|
|
$cps->pctcpuSearchSetString('>60');
|
|
|
|
=cut
|
|
|
|
sub pctcpuSearchSetString{
|
|
my $self=$_[0];
|
|
my $pctcpu_search_string=$_[1];
|
|
$self->errorblank;
|
|
|
|
my @pctcpu_search_array;
|
|
if ( ! defined( $pctcpu_search_string ) ){
|
|
$self->{pctcpu_search}=\@pctcpu_search_array;
|
|
}else{
|
|
@pctcpu_search_array=split(/\,/, $pctcpu_search_string);
|
|
|
|
foreach my $item ( @pctcpu_search_array ){
|
|
if (
|
|
( $item !~ /^\>[0123456789]*$/ ) &&
|
|
( $item !~ /^\>=[0123456789]*$/ ) &&
|
|
( $item !~ /^\<[0123456789]*$/ ) &&
|
|
( $item !~ /^\<=[0123456789]*$/ )
|
|
){
|
|
$self->{error}=2;
|
|
$self->{errorString}='"'.$item.'"" is not a valid value for use in a PCT CPU search';
|
|
$self->warn;
|
|
return undef;
|
|
}
|
|
|
|
}
|
|
|
|
$self->{pctcpu_search}=\@pctcpu_search_array;
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
=head2 pctmemSearchGet
|
|
|
|
Returns the current value for the PCT MEM search.
|
|
|
|
The return is a array ref.
|
|
|
|
my $pctmem_search=$cps->pctmemSearchGet;
|
|
|
|
=cut
|
|
|
|
sub pctmemSearchGet{
|
|
my $self=$_[0];
|
|
$self->errorblank;
|
|
|
|
return $self->{pctmem_search};
|
|
}
|
|
|
|
=head2 pctmemSearchSetString
|
|
|
|
Search for procs based on the memory usage.
|
|
|
|
The following equalities are understood.
|
|
|
|
<=
|
|
<
|
|
>
|
|
>=
|
|
|
|
The string may contain multiple values seperated by a comma. Checking will stop after the first hit.
|
|
|
|
If the string is undef, all procs will be shown.
|
|
|
|
#search for procs with less than 60% of the memory
|
|
$cps->pctmemSearchSetString('<60');
|
|
#shows procs with greater than 60% of the memory
|
|
$cps->pctmemSearchSetString('>60');
|
|
|
|
=cut
|
|
|
|
sub pctmemSearchSetString{
|
|
my $self=$_[0];
|
|
my $pctmem_search_string=$_[1];
|
|
$self->errorblank;
|
|
|
|
my @pctmem_search_array;
|
|
if ( ! defined( $pctmem_search_string ) ){
|
|
$self->{pctmem_search}=\@pctmem_search_array;
|
|
}else{
|
|
@pctmem_search_array=split(/\,/, $pctmem_search_string);
|
|
|
|
foreach my $item ( @pctmem_search_array ){
|
|
if (
|
|
( $item !~ /^\>[0123456789]*$/ ) &&
|
|
( $item !~ /^\>=[0123456789]*$/ ) &&
|
|
( $item !~ /^\<[0123456789]*$/ ) &&
|
|
( $item !~ /^\<=[0123456789]*$/ )
|
|
){
|
|
$self->{error}=3;
|
|
$self->{errorString}='"'.$item.'"" is not a valid value for use in a PCT MEM search';
|
|
$self->warn;
|
|
return undef;
|
|
}
|
|
|
|
}
|
|
|
|
$self->{pctmem_search}=\@pctmem_search_array;
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
=head2 processColorGet
|
|
|
|
my $timeColors=$cps->processColorGet;
|
|
|
|
=cut
|
|
|
|
sub processColorGet{
|
|
my $self=$_[0];
|
|
$self->errorblank;
|
|
|
|
return $self->{processColor};
|
|
}
|
|
|
|
=head2 procSearchGet
|
|
|
|
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->procSearchGet;
|
|
if ( defined( $search_regex ) ){
|
|
print "search regex: ".$search_regex."\n";
|
|
}else{
|
|
print "No search regex.\n";
|
|
}
|
|
|
|
=cut
|
|
|
|
sub procSearchGet{
|
|
my $self=$_[0];
|
|
$self->errorblank;
|
|
|
|
return $self->{proc_search};
|
|
}
|
|
|
|
=head2 procSearchSet
|
|
|
|
This sets the proc column search regex to use.
|
|
|
|
If set to undef(the default), then it will show all procs.
|
|
|
|
#shows everything
|
|
$cps->procSearchSet( undef );
|
|
|
|
#search for only those matching musicpd
|
|
$cps->procSeearchSet( 'musicpd' );
|
|
|
|
#search for those that match /[Zz]whatever/
|
|
$cps->procSearchSet( '[Zz]whatever' );
|
|
|
|
=cut
|
|
|
|
sub procSearchSet{
|
|
my $self=$_[0];
|
|
my $proc_search=$_[1];
|
|
$self->errorblank;
|
|
|
|
$self->{proc_search}=$proc_search;
|
|
|
|
return 1;
|
|
}
|
|
|
|
=head2 selfIgnoreGet
|
|
|
|
=cut
|
|
|
|
sub selfIgnoreGet{
|
|
my $self=$_[0];
|
|
$self->errorblank;
|
|
|
|
return $self->{self_ignore};
|
|
}
|
|
|
|
=head2 selfIgnoreSet
|
|
|
|
Wether or not to show the PID of this processes in the list.
|
|
|
|
=head3 undef
|
|
|
|
Resets it to the default, 2.
|
|
|
|
=head3 0
|
|
|
|
Always show self PID in the list.
|
|
|
|
=head3 1
|
|
|
|
Never show self PID in the list.
|
|
|
|
=head3 2
|
|
|
|
Don't show self PID if it is a search.
|
|
|
|
This is the default.
|
|
|
|
=cut
|
|
|
|
sub selfIgnoreSet{
|
|
my $self=$_[0];
|
|
my $self_ignore=$_[1];
|
|
$self->errorblank;
|
|
|
|
if ( ! defined( $self_ignore ) ){
|
|
$self_ignore='2';
|
|
}
|
|
|
|
$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 swappedOutSearchGet
|
|
|
|
Returns the current value for the swapped out search.
|
|
|
|
The return is a Perl boolean.
|
|
|
|
my $swappedOut_search=$cps->swappedOutSearchGet;
|
|
if ( $swappedOut_search ){
|
|
print "only swapped out procs will be shown";
|
|
}
|
|
|
|
=cut
|
|
|
|
sub swappedOutSearchGet{
|
|
my $self=$_[0];
|
|
$self->errorblank;
|
|
|
|
return $self->{swapped_out_search};
|
|
}
|
|
|
|
=head2 swappedOutSearchSet
|
|
|
|
Sets the swapped out search value.
|
|
|
|
The value taken is a Perl boolean.
|
|
|
|
$cps->swappedOutSearchSet( 1 );
|
|
|
|
=cut
|
|
|
|
sub swappedOutSearchSet{
|
|
my $self=$_[0];
|
|
my $swapped_out_search=$_[1];
|
|
$self->errorblank;
|
|
|
|
$self->{swapped_out_search}=$swapped_out_search;
|
|
|
|
return 1;
|
|
}
|
|
|
|
=head2 timeColorsGet
|
|
|
|
my $timeColors=$cps->timeColorsGet;
|
|
|
|
=cut
|
|
|
|
sub timeColorsGet{
|
|
my $self=$_[0];
|
|
$self->errorblank;
|
|
|
|
return $self->{timeColors};
|
|
}
|
|
|
|
=head2 timeSearchGet
|
|
|
|
Returns the current value for the time search.
|
|
|
|
The return is a array ref.
|
|
|
|
my $time_search=$cps->waitSearchGet;
|
|
|
|
=cut
|
|
|
|
sub timeSearchGet{
|
|
my $self=$_[0];
|
|
$self->errorblank;
|
|
|
|
return $self->{time_search};
|
|
}
|
|
|
|
=head2 timeSearchSetString
|
|
|
|
Search for procs based on the CPU time value.
|
|
|
|
The following equalities are understood.
|
|
|
|
<=
|
|
<
|
|
>
|
|
>=
|
|
|
|
The string may contain multiple values seperated by a comma. Checking will stop after the first hit.
|
|
|
|
If the string is undef, all wait channels will be shown.
|
|
|
|
#search for procs with less than 60 seconds of CPU time
|
|
$cps->waitSearchSetString('<69');
|
|
#shows procs with less than 60 seconds and greater 120 seconds
|
|
$cps->waitSearchSetString('<60,>120');
|
|
|
|
=cut
|
|
|
|
sub timeSearchSetString{
|
|
my $self=$_[0];
|
|
my $time_search_string=$_[1];
|
|
$self->errorblank;
|
|
|
|
my @time_search_array;
|
|
if ( ! defined( $time_search_string ) ){
|
|
$self->{time_search}=\@time_search_array;
|
|
}else{
|
|
@time_search_array=split(/\,/, $time_search_string);
|
|
|
|
foreach my $item ( @time_search_array ){
|
|
if (
|
|
( $item !~ /^\>[0123456789]*$/ ) &&
|
|
( $item !~ /^\>=[0123456789]*$/ ) &&
|
|
( $item !~ /^\<[0123456789]*$/ ) &&
|
|
( $item !~ /^\<=[0123456789]*$/ )
|
|
){
|
|
$self->{error}=1;
|
|
$self->{errorString}='"'.$item.'"" is not a valid value for use in a time search';
|
|
$self->warn;
|
|
return undef;
|
|
}
|
|
|
|
}
|
|
|
|
$self->{time_search}=\@time_search_array;
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
=head2 timeString
|
|
|
|
Turns the raw run string into something usable.
|
|
|
|
This returns a colorized item.
|
|
|
|
my $time=$cps->timeString( $seconds );
|
|
|
|
=cut
|
|
|
|
sub timeString{
|
|
my $self=$_[0];
|
|
my $time=$_[1];
|
|
$self->errorblank;
|
|
|
|
my $colors=$self->timeColorsGet;
|
|
|
|
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;
|
|
|
|
#nicely format it
|
|
$hours=~s/\..*//;
|
|
$minutes=~s/\..*//;
|
|
$seconds=sprintf('%.f',$seconds);
|
|
|
|
#this will be returned
|
|
my $toReturn='';
|
|
|
|
#process the hours bit
|
|
if ( $hours == 0 ){
|
|
#don't do anything if time is 0
|
|
}elsif(
|
|
$hours >= 10
|
|
){
|
|
$toReturn=color($colors->[3]).$hours.':';
|
|
}else{
|
|
$toReturn=color($colors->[2]).$hours.':';
|
|
}
|
|
|
|
#process the minutes bit
|
|
if (
|
|
( $hours > 0 ) ||
|
|
( $minutes > 0 )
|
|
){
|
|
$toReturn=$toReturn.color( $colors->[1] ). $minutes.':';
|
|
}
|
|
|
|
$toReturn=$toReturn.color( $colors->[0] ).$seconds;
|
|
|
|
return $toReturn;
|
|
}
|
|
|
|
=head1 userSearchGet
|
|
|
|
This gets the user to be searched for and if it should be inverted or not.
|
|
|
|
This returns an array reference of users to search for.
|
|
|
|
An selection can be inverted via !.
|
|
|
|
my $user_search=$cps->userSearchGet;
|
|
|
|
=cut
|
|
|
|
sub userSearchGet{
|
|
my $self=$_[0];
|
|
$self->errorblank;
|
|
|
|
return $self->{user_search};
|
|
}
|
|
|
|
=head1 userSearchSetString
|
|
|
|
This takes a string to set the user search for.
|
|
|
|
An selection can be inverted via !.
|
|
|
|
The string may contain multiple users seperated by a comma.
|
|
|
|
If the string is undef, all users will be shown.
|
|
|
|
#search for user foo and bar
|
|
$cps->userSearchSetString('foo,bar');
|
|
#show users not matching foo
|
|
$cps->userSearchSetString('!foo');
|
|
#show all users, clearing any previous settings
|
|
$cps->userSearchSetString;
|
|
|
|
=cut
|
|
|
|
sub userSearchSetString{
|
|
my $self=$_[0];
|
|
my $user_search_string=$_[1];
|
|
$self->errorblank;
|
|
|
|
my @user_search_array;
|
|
if ( ! defined( $user_search_string ) ){
|
|
$self->{user_search}=\@user_search_array;
|
|
}else{
|
|
@user_search_array=split(/\,/, $user_search_string);
|
|
$self->{user_search}=\@user_search_array;
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
=head2 waitSearchGet
|
|
|
|
Returns the current value for the wait search.
|
|
|
|
The return is a array ref.
|
|
|
|
my $wait_search=$cps->waitSearchGet;
|
|
|
|
=cut
|
|
|
|
sub waitSearchGet{
|
|
my $self=$_[0];
|
|
$self->errorblank;
|
|
|
|
return $self->{wait_search};
|
|
}
|
|
|
|
=head2 waitSearchSetString
|
|
|
|
This takes a string to set the wait channel search for.
|
|
|
|
An selection can be inverted via !.
|
|
|
|
The string may contain multiple users seperated by a comma.
|
|
|
|
If the string is undef, all wait channels will be shown.
|
|
|
|
#search for wait channel wait and sleep
|
|
$cps->waitSearchSetString('wait,sleep');
|
|
#shows wait channels not matching sbwait
|
|
$cps->waitSearchSetString('!sbwait');
|
|
#show all users, clearing any previous settings
|
|
$cps->waitSearchSetString;
|
|
|
|
=cut
|
|
|
|
sub waitSearchSetString{
|
|
my $self=$_[0];
|
|
my $wait_search_string=$_[1];
|
|
$self->errorblank;
|
|
|
|
my @wait_search_array;
|
|
if ( ! defined( $wait_search_string ) ){
|
|
$self->{wait_search}=\@wait_search_array;
|
|
}else{
|
|
@wait_search_array=split(/\,/, $wait_search_string);
|
|
$self->{wait_search}=\@wait_search_array;
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
=head2 zombieSearchGet
|
|
|
|
Returns the current value for the zombie search.
|
|
|
|
The return is a Perl boolean.
|
|
|
|
my $zombie_search=$cps->zombieSearchGet;
|
|
if ( $zombie_search ){
|
|
print "only zombie procs will be shown";
|
|
}
|
|
|
|
=cut
|
|
|
|
sub zombieSearchGet{
|
|
my $self=$_[0];
|
|
$self->errorblank;
|
|
|
|
return $self->{zombie_search};
|
|
}
|
|
|
|
=head2 zombieSearchSet
|
|
|
|
Sets the zombie search value.
|
|
|
|
The value taken is a Perl boolean.
|
|
|
|
$cps->zombieSearchSet( 1 );
|
|
|
|
=cut
|
|
|
|
sub zombieSearchSet{
|
|
my $self=$_[0];
|
|
my $zombie_search=$_[1];
|
|
$self->errorblank;
|
|
|
|
$self->{zombie_search}=$zombie_search;
|
|
|
|
return 1;
|
|
}
|
|
|
|
=head1 COLORS
|
|
|
|
These corresponds to L<Term::ANSIColor> colors.
|
|
|
|
=head2 Time
|
|
|
|
The color column is not a single color, but multiple depending on the amount of time.
|
|
|
|
The default is as below.
|
|
|
|
'GREEN', seconds
|
|
'BRIGHT_GREEN', minutes
|
|
'RED', hours
|
|
'BRIGHT_RED', 10+ hours
|
|
|
|
=head2 Columns
|
|
|
|
The non-proc/time columns are colored in a rotating color sequence.
|
|
|
|
The default is as below.
|
|
|
|
BRIGHT_YELLOW
|
|
BRIGHT_CYAN
|
|
BRIGHT_MAGENTA
|
|
BRIGHT_BLUE
|
|
|
|
=head1 ERROR CODES/FLAGS
|
|
|
|
=head2 1 / badTimeString
|
|
|
|
The time search string contains errors.
|
|
|
|
=head2 2 / badPctcpuString
|
|
|
|
The PCT CPU search string contains errors.
|
|
|
|
=head2 3 / badPctmemString
|
|
|
|
The PCT MEM search string contains errors.
|
|
|
|
=head1 AUTHOR
|
|
|
|
Zane C. Bowers-Hadley, C<< <vvelox at vvelox.net> >>
|
|
|
|
=head1 BUGS
|
|
|
|
Please report any bugs or feature requests to C<bug-proc-processtable-colorizer at rt.cpan.org>, or through
|
|
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Proc-ProcessTable-Colorizer>. I will be notified, and then you'll
|
|
automatically be notified of progress on your bug as I make changes.
|
|
|
|
|
|
|
|
|
|
=head1 SUPPORT
|
|
|
|
You can find documentation for this module with the perldoc command.
|
|
|
|
perldoc Proc::ProcessTable::Colorizer
|
|
|
|
|
|
You can also look for information at:
|
|
|
|
=over 4
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here)
|
|
|
|
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Proc-ProcessTable-Colorizer>
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation
|
|
|
|
L<http://annocpan.org/dist/Proc-ProcessTable-Colorizer>
|
|
|
|
=item * CPAN Ratings
|
|
|
|
L<http://cpanratings.perl.org/d/Proc-ProcessTable-Colorizer>
|
|
|
|
=item * Search CPAN
|
|
|
|
L<http://search.cpan.org/dist/Proc-ProcessTable-Colorizer/>
|
|
|
|
=back
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT
|
|
|
|
Copyright 2017 Zane C. Bowers-Hadley.
|
|
|
|
This program is distributed under the (Simplified) BSD License:
|
|
L<http://www.opensource.org/licenses/BSD-2-Clause>
|
|
|
|
Redistribution and use in source and binary forms, with or without
|
|
modification, are permitted provided that the following conditions
|
|
are met:
|
|
|
|
* Redistributions of source code must retain the above copyright
|
|
notice, this list of conditions and the following disclaimer.
|
|
|
|
* Redistributions in binary form must reproduce the above copyright
|
|
notice, this list of conditions and the following disclaimer in the
|
|
documentation and/or other materials provided with the distribution.
|
|
|
|
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
|
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
|
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
|
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
|
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
|
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
|
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
|
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
|
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
|
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
|
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
|
|
|
|
=cut
|
|
|
|
1; # End of Proc::ProcessTable::Colorizer
|