misc work done on it
This commit is contained in:
parent
73d251bb50
commit
67eaf26a08
|
|
@ -4,25 +4,28 @@ use warnings;
|
|||
use ExtUtils::MakeMaker;
|
||||
|
||||
my %WriteMakefileArgs = (
|
||||
NAME => 'Proc::ProcessTable::piddler',
|
||||
AUTHOR => q{Zane C. Bowers-Hadley <vvelox@vvelox.net>},
|
||||
VERSION_FROM => 'lib/Proc/ProcessTable/piddler.pm',
|
||||
ABSTRACT_FROM => 'lib/Proc/ProcessTable/piddler.pm',
|
||||
LICENSE => 'artistic_2',
|
||||
MIN_PERL_VERSION => '5.006',
|
||||
CONFIGURE_REQUIRES => {
|
||||
'ExtUtils::MakeMaker' => '0',
|
||||
},
|
||||
TEST_REQUIRES => {
|
||||
'Test::More' => '0',
|
||||
},
|
||||
PREREQ_PM => {
|
||||
#'ABC' => '1.6',
|
||||
#'Foo::Bar::Module' => '5.0401',
|
||||
},
|
||||
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
|
||||
clean => { FILES => 'Proc-ProcessTable-piddler-*' },
|
||||
);
|
||||
NAME => 'Proc::ProcessTable::piddler',
|
||||
AUTHOR => q{Zane C. Bowers-Hadley <vvelox@vvelox.net>},
|
||||
VERSION_FROM => 'lib/Proc/ProcessTable/piddler.pm',
|
||||
ABSTRACT_FROM => 'lib/Proc/ProcessTable/piddler.pm',
|
||||
LICENSE => 'artistic_2',
|
||||
MIN_PERL_VERSION => '5.006',
|
||||
CONFIGURE_REQUIRES => {
|
||||
'ExtUtils::MakeMaker' => '0',
|
||||
},
|
||||
TEST_REQUIRES => {
|
||||
'Test::More' => '0',
|
||||
},
|
||||
PREREQ_PM => {
|
||||
'Term::ANSIColor'=>'4.06',
|
||||
'Text::ANSITable'=>'0.501',
|
||||
'Getopt::Long'=>'0.0.0',
|
||||
'Data::Unixish::Apply'=>'1.570',
|
||||
'Proc::ProcessTable'=>'0.59',
|
||||
},
|
||||
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
|
||||
clean => { FILES => 'Proc-ProcessTable-piddler-*' },
|
||||
);
|
||||
|
||||
# Compatibility with old versions of ExtUtils::MakeMaker
|
||||
unless (eval { ExtUtils::MakeMaker->VERSION('6.64'); 1 }) {
|
||||
|
|
@ -36,10 +39,10 @@ unless (eval { ExtUtils::MakeMaker->VERSION('6.55_03'); 1 }) {
|
|||
}
|
||||
|
||||
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
|
||||
unless eval { ExtUtils::MakeMaker->VERSION('6.52'); 1 };
|
||||
unless eval { ExtUtils::MakeMaker->VERSION('6.52'); 1 };
|
||||
delete $WriteMakefileArgs{MIN_PERL_VERSION}
|
||||
unless eval { ExtUtils::MakeMaker->VERSION('6.48'); 1 };
|
||||
unless eval { ExtUtils::MakeMaker->VERSION('6.48'); 1 };
|
||||
delete $WriteMakefileArgs{LICENSE}
|
||||
unless eval { ExtUtils::MakeMaker->VERSION('6.31'); 1 };
|
||||
unless eval { ExtUtils::MakeMaker->VERSION('6.31'); 1 };
|
||||
|
||||
WriteMakefile(%WriteMakefileArgs);
|
||||
|
|
|
|||
|
|
@ -3,52 +3,273 @@ package Proc::ProcessTable::piddler;
|
|||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Proc::ProcessTable;
|
||||
use Text::ANSITable;
|
||||
use Term::ANSIColor;
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Proc::ProcessTable::piddler - The great new Proc::ProcessTable::piddler!
|
||||
Proc::ProcessTable::piddler -
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
Version 0.01
|
||||
Version 0.0.0
|
||||
|
||||
=cut
|
||||
|
||||
our $VERSION = '0.01';
|
||||
our $VERSION = '0.0.0';
|
||||
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
Quick summary of what the module does.
|
||||
|
||||
Perhaps a little code snippet.
|
||||
|
||||
use Proc::ProcessTable::piddler;
|
||||
|
||||
my $foo = Proc::ProcessTable::piddler->new();
|
||||
my $piddler = Proc::ProcessTable::piddler->new();
|
||||
...
|
||||
|
||||
=head1 EXPORT
|
||||
=head1 METHODS
|
||||
|
||||
A list of functions that can be exported. You can delete this section
|
||||
if you don't export anything, such as for a purely object-oriented module.
|
||||
=sub new
|
||||
|
||||
=head1 SUBROUTINES/METHODS
|
||||
Initiates the object.
|
||||
|
||||
=head2 function1
|
||||
my $piddler = Proc::ProcessTable::piddler->new();
|
||||
|
||||
=cut
|
||||
|
||||
sub function1 {
|
||||
sub new{
|
||||
my $self = {
|
||||
colors=>[
|
||||
'BRIGHT_YELLOW',
|
||||
'BRIGHT_CYAN',
|
||||
'BRIGHT_MAGENTA',
|
||||
'BRIGHT_BLUE'
|
||||
],
|
||||
timeColors=>[
|
||||
'GREEN',
|
||||
'BRIGHT_GREEN',
|
||||
'RED',
|
||||
'BRIGHT_RED'
|
||||
],
|
||||
vszColors=>[
|
||||
'GREEN',
|
||||
'YELLOW',
|
||||
'RED',
|
||||
'BRIGHT_BLUE'
|
||||
],
|
||||
rssColors=>[
|
||||
'BRIGHT_GREEN',
|
||||
'BRIGHT_YELLOW',
|
||||
'BRIGHT_RED',
|
||||
'BRIGHT_BLUE'
|
||||
],
|
||||
processColor=>'BRIGHT_RED',
|
||||
varColor=>'GREEN',
|
||||
valColor=>'WHITE',
|
||||
pidColor=>'BRIGHT_CYAN',
|
||||
cpuColor=>'BRIGHT_MAGENTA',
|
||||
memColor=>'BRIGHT_BLUE',
|
||||
idColors=>[
|
||||
'WHITE',
|
||||
'BRIGHT_BLUE',
|
||||
'MAGENTA',
|
||||
],
|
||||
};
|
||||
bless $self;
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
=head2 function2
|
||||
=head2 run
|
||||
|
||||
=cut
|
||||
|
||||
sub function2 {
|
||||
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} );
|
||||
|
||||
my @procs;
|
||||
foreach my $proc ( @{ $pt } ){
|
||||
if ( defined( $pids_hash{ $proc->pid } ) ){
|
||||
push( @procs, $proc );
|
||||
}
|
||||
}
|
||||
|
||||
if (!defined( $procs[0] )){
|
||||
return ''
|
||||
}
|
||||
|
||||
my $toReturn='';
|
||||
|
||||
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);
|
||||
|
||||
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'),
|
||||
color( $self->{pidColor} ).$user.color('reset')
|
||||
]);
|
||||
|
||||
|
||||
push( @data, [
|
||||
color( $self->{varColor} ).'CPU%'.color('reset'),
|
||||
color( $self->{pidColor} ).$proc->pctcpu.color('reset')
|
||||
]);
|
||||
}
|
||||
|
||||
return $toReturn;
|
||||
}
|
||||
|
||||
=head2 timeString
|
||||
|
||||
Turns the raw run string into something usable.
|
||||
|
||||
=cut
|
||||
|
||||
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;
|
||||
|
||||
#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($self->{timeColors}->[3]).$hours.':';
|
||||
} else {
|
||||
$toReturn=color($self->{timeColors}->[2]).$hours.':';
|
||||
}
|
||||
|
||||
#process the minutes bit
|
||||
if (
|
||||
( $hours > 0 ) ||
|
||||
( $minutes > 0 )
|
||||
) {
|
||||
$toReturn=$toReturn.color( $self->{timeColors}->[1] ). $minutes.':';
|
||||
}
|
||||
|
||||
$toReturn=$toReturn.color( $self->{timeColors}->[0] ).$seconds.color('reset');
|
||||
|
||||
return $toReturn;
|
||||
}
|
||||
|
||||
=head2 memString
|
||||
|
||||
Turns the raw run string into something usable.
|
||||
|
||||
=cut
|
||||
|
||||
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');
|
||||
}
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Zane C. Bowers-Hadley, C<< <vvelox at vvelox.net> >>
|
||||
|
|
|
|||
Loading…
Reference in New Issue