lots of misc changes and mostly working

This commit is contained in:
Charlie Root 2019-02-24 05:54:32 -06:00
parent 077357e285
commit 3556c281b4
4 changed files with 321 additions and 103 deletions

View File

@ -4,23 +4,23 @@ use warnings;
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'Parse::Netstat::Colorizer',
AUTHOR => q{Zane C. Bowers-Hadley <vvelox@vvelox.net>},
VERSION_FROM => 'lib/Parse/Netstat/Colorizer.pm',
ABSTRACT_FROM => 'lib/Parse/Netstat/Colorizer.pm',
LICENSE => 'artistic_2',
PL_FILES => {},
MIN_PERL_VERSION => '5.006',
CONFIGURE_REQUIRES => {
'ExtUtils::MakeMaker' => '0',
},
BUILD_REQUIRES => {
'Test::More' => '0',
},
PREREQ_PM => {
#'ABC' => '1.6',
#'Foo::Bar::Module' => '5.0401',
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'Parse-Netstat-Colorizer-*' },
);
NAME => 'Parse::Netstat::Colorizer',
AUTHOR => q{Zane C. Bowers-Hadley <vvelox@vvelox.net>},
VERSION_FROM => 'lib/Parse/Netstat/Colorizer.pm',
ABSTRACT_FROM => 'lib/Parse/Netstat/Colorizer.pm',
LICENSE => 'artistic_2',
PL_FILES => {},
MIN_PERL_VERSION => '5.006',
CONFIGURE_REQUIRES => {
'ExtUtils::MakeMaker' => '0',
},
BUILD_REQUIRES => {
'Test::More' => '0',
},
PREREQ_PM => {
'Parse::Netstat'=>'0.14',
'Parse::Netstat::Search'=>'0.0.0',
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'Parse-Netstat-Colorizer-*' },
);

View File

@ -1,17 +1,7 @@
Parse-Netstat-Colorizer
The README is used to introduce the module and provide instructions on
how to install the module, any machine dependencies it may have (for
example C compilers and installed libraries) and any other information
that should be provided before the module is installed.
A README file is required for CPAN modules since CPAN extracts the README
file from a module distribution so that people browsing the archive
can use it to get an idea of the module's uses. It is usually a good idea
to provide version information here so that people can decide whether
fixes for the module are worth downloading.
Takes the parsed output from Parse::Netstat and allows it
to be sorted and searched. It colorizes the output.
INSTALLATION
To install this module, run the following commands:

View File

@ -3,18 +3,24 @@ package Parse::Netstat::Colorizer;
use 5.006;
use strict;
use warnings;
use base 'Error::Helper';
use Parse::Netstat;
use Parse::Netstat::Search;
use Term::ANSIColor;
use Text::Table;
use Net::IP;
=head1 NAME
Parse::Netstat::Colorizer - The great new Parse::Netstat::Colorizer!
Parse::Netstat::Colorizer - Searches and colorizes the output from
=head1 VERSION
Version 0.01
Version 0.0.0
=cut
our $VERSION = '0.01';
our $VERSION = '0.0.0';
=head1 SYNOPSIS
@ -25,30 +31,309 @@ Perhaps a little code snippet.
use Parse::Netstat::Colorizer;
my $foo = Parse::Netstat::Colorizer->new();
my $nsc = Parse::Netstat::Colorizer->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.
=head1 SUBROUTINES/METHODS
=head2 function1
=head2 new
=cut
sub function1 {
sub new {
my $self={
perror=>undef,
error=>undef,
errorString=>'',
errorExtra=>{
1 => 'badResults',
2 => 'searchErrored',
3 => 'badSort',
},
os=>$^O,
sort=>'host_ff',
invert=>undef,
search=>Parse::Netstat::Search->new,
sort_check=>{
host_ff=>1,
host_lf=>1,
host_f=>1,
host_l=>1,
port_ff=>1,
port_lf=>1,
port_f=>1,
port_l=>1,
state=>1,
protocol=>1,
q_rf=>1,
q_sf=>1,
q_r=>1,
q_s=>1,
none=>1,
}
};
bless $self;
return $self;
}
=head2 function2
=head1 colorize
This runs the configured search and colorizes
the output.
One value is taken and that is the array ref returned
by Parse::Netstat.
my $colorized=$pnc->colorize($res);
=cut
sub function2 {
sub colorize{
my $self=$_[0];
my $res=$_[1];
if( ! $self->errorblank ){
return undef;
}
#make sure what ever we are passed is sane and very likely a return from Parse::Netdata
if (
( ref( $res ) ne 'ARRAY' ) ||
( ! defined( $res->[2] ) ) ||
( ! defined( $res->[2]->{active_conns} ) )
){
$self->{error}=1;
$self->{errorString}='$res->[2]->{active_conns} not defiend. Does not appear to be a Parse::Netstat return';
$self->warn;
return undef;
}
my @found=$self->{search}->search( $res );
# handle sorting if needed
if ( $self->{sort} ne 'none' ){
if( $self->{sort} eq 'host_ff' ){
@found=sort {
eval { Net::IP->new( $a->{foreign_host} )->intip} <=> eval { Net::IP->new( $b->{foreign_host} )->intip} or
eval { Net::IP->new( $a->{local_host} )->intip} <=> eval { Net::IP->new( $b->{local_host} )->intip}
} @found;
}elsif( $self->{sort} eq 'host_lf' ){
@found=sort {
eval { Net::IP->new( $a->{local_host} )->intip} <=> eval { Net::IP->new( $b->{local_host} )->intip} or
eval { Net::IP->new( $a->{foreign_host} )->intip} <=> eval { Net::IP->new( $b->{foreign_host} )->intip}
} @found;
}elsif( $self->{sort} eq 'host_f' ){
@found=sort {
eval { Net::IP->new( $a->{foreign_host} )->intip} <=> eval { Net::IP->new( $b->{foreign_host} )->intip}
} @found;
}elsif( $self->{sort} eq 'host_l' ){
@found=sort {
eval { Net::IP->new( $a->{local_host} )->intip} <=> eval { Net::IP->new( $b->{local_host} )->intip}
} @found;
}elsif( $self->{sort} eq 'port_ff' ){
@found=sort {
eval { Net::IP->new( $a->{foreign_port} )->intip} <=> eval { Net::IP->new( $b->{foreign_port} )->intip} or
eval { Net::IP->new( $a->{local_port} )->intip} <=> eval { Net::IP->new( $b->{local_port} )->intip}
} @found;
}elsif( $self->{sort} eq 'port_lf' ){
@found=sort {
eval { Net::IP->new( $a->{local_port} )->intip} <=> eval { Net::IP->new( $b->{local_port} )->intip} or
eval { Net::IP->new( $a->{foreign_port} )->intip} <=> eval { Net::IP->new( $b->{foreign_port} )->intip}
} @found;
}elsif( $self->{sort} eq 'port_f' ){
@found=sort {
eval { Net::IP->new( $a->{foreign_port} )->intip} <=> eval { Net::IP->new( $b->{foreign_port} )->intip}
} @found;
}elsif( $self->{sort} eq 'port_l' ){
@found=sort {
eval { Net::IP->new( $a->{local_port} )->intip} <=> eval { Net::IP->new( $b->{local_port} )->intip}
} @found;
}elsif( $self->{sort} eq 'state' ){
@found=sort {
eval { Net::IP->new( $a->{state} )->intip} <=> eval { Net::IP->new( $b->{state} )->intip}
} @found;
}elsif( $self->{sort} eq 'protocol' ){
@found=sort {
eval { Net::IP->new( $a->{proto} )->intip} <=> eval { Net::IP->new( $b->{proto} )->intip}
} @found;
}elsif( $self->{sort} eq 'q_rf' ){
@found=sort {
eval { Net::IP->new( $a->{recvq} )->intip} <=> eval { Net::IP->new( $b->{recvq} )->intip} or
eval { Net::IP->new( $a->{sendq} )->intip} <=> eval { Net::IP->new( $b->{sendq} )->intip}
} @found;
}elsif( $self->{sort} eq 'q_sf' ){
@found=sort {
eval { Net::IP->new( $a->{sendq} )->intip} <=> eval { Net::IP->new( $b->{sendq} )->intip} or
eval { Net::IP->new( $a->{recvq} )->intip} <=> eval { Net::IP->new( $b->{recvq} )->intip}
} @found;
}elsif( $self->{sort} eq 'q_r' ){
@found=sort {
eval { Net::IP->new( $a->{recvq} )->intip} <=> eval { Net::IP->new( $b->{recvq} )->intip}
} @found;
}elsif( $self->{sort} eq 'q_s' ){
@found=sort {
eval { Net::IP->new( $a->{sendq} )->intip} <=> eval { Net::IP->new( $b->{sendq} )->intip}
} @found;
}
}
# invert if needed
if ( $self->{invert} ){
@found=reverse(@found);
}
# Holds colorized lines for the table.
#
my @colored=([
color('underline white').'Proto'.color('reset'),
color('underline white').'SendQ'.color('reset'),
color('underline white').'RecvQ'.color('reset'),
color('underline white').'Local Host'.color('reset'),
color('underline white').'Port'.color('reset'),
color('underline white').'Remove Host'.color('reset'),
color('underline white').'Port'.color('reset'),
color('underline white').'State'.color('reset'),
]);
# process each connection
my $conn=pop(@found);
while ( defined( $conn->{local_port} ) ){
my @new_line=(
color('BRIGHT_YELLOW').$conn->{proto}.color('reset'),
color('BRIGHT_CYAN').$conn->{sendq}.color('reset'),
color('BRIGHT_RED').$conn->{recvq}.color('reset'),
color('BRIGHT_GREEN').$conn->{local_host}.color('reset'),
color('GREEN').$conn->{local_port}.color('reset'),
color('BRIGHT_MAGENTA').$conn->{foreign_host}.color('reset'),
color('MAGENTA').$conn->{foreign_port}.color('reset'),
color('BRIGHT_BLUE').$conn->{state}.color('reset'),
);
push( @colored, \@new_line );
$conn=pop(@found);
}
my $tb = Text::Table->new;
return $tb->load( @colored );
}
=head1 get_search
This returns the Parse::Netstat::Search object.
my $search=$pnc->get_search;
=cut
sub get_search{
my $self=$_[0];
if( ! $self->errorblank ){
return undef;
}
return $self->{search};
}
=head2 get_search
This returns the current sort method and invert
values.
Please be aware as the invert value is a boolean,
it may not be defined(which it is not by default).
my ($sort, $invert)=$pnc->get_sort;
=cut
sub get_sort{
my $self=$_[0];
if( ! $self->errorblank ){
return undef;
}
return $self->{sort}, $self->{invert};
}
=head2 set_sort
This sets the sort method to be used and if it should
be inverted.
The first argument is the sort method name and the second is a
boolean on if it should be inverted or not.
Leaving either undef resets the undef value back to the default.
The supported sorting methods are as below.
host_ff Host, Foreign First (default)
host_lf Host, Local First
host_f Host, Foreign
host_l Host, Local
port_ff Port, Foreign First
port_lf Port, Local First
port_f Port, Foriegn
port_l Port, Local
state State
protocol Protocol
q_rf Queue, Receive First
q_sf Queue, Send First
q_r Queue, Receive
q_s Queue, Send
none No sorting is done.
=cut
sub set_sort{
my $self=$_[0];
my $sort=$_[1];
my $invert=$_[2];
if( ! $self->errorblank ){
return undef;
}
if (!defined( $sort ) ){
$sort='host_ff';
}
if ( ! defined( $self->{sort_check}{$sort} ) ){
$self->{error}=1;
$self->{errorString}='"'.$sort.'" is not a valid sort value';
$self->warn;
return undef;
}
$self->{sort}=$sort;
$self->{invert}=$invert;
return 1;
}
=head
=head1 ERROR CODES / FLAGS
Error handling is provided by L<Error::Helper>.
=head2 1 / badResults
The passed Parse::Netstat array does not appear to be properly formatted.
=head2 2 / searchErrored
Parse::Netstat::Search->search errored.
=head2 3 / badSort
Invalid value specified for sort.
=head1 AUTHOR
Zane C. Bowers-Hadley, C<< <vvelox at vvelox.net> >>

View File

@ -1,57 +0,0 @@
#!perl -T
use 5.006;
use strict;
use warnings;
use Test::More;
plan tests => 3;
sub not_in_file_ok {
my ($filename, %regex) = @_;
open( my $fh, '<', $filename )
or die "couldn't open $filename for reading: $!";
my %violated;
while (my $line = <$fh>) {
while (my ($desc, $regex) = each %regex) {
if ($line =~ $regex) {
push @{$violated{$desc}||=[]}, $.;
}
}
}
if (%violated) {
fail("$filename contains boilerplate text");
diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
} else {
pass("$filename contains no boilerplate text");
}
}
sub module_boilerplate_ok {
my ($module) = @_;
not_in_file_ok($module =>
'the great new $MODULENAME' => qr/ - The great new /,
'boilerplate description' => qr/Quick summary of what the module/,
'stub function definition' => qr/function[12]/,
);
}
TODO: {
local $TODO = "Need to replace the boilerplate text";
not_in_file_ok(README =>
"The README is used..." => qr/The README is used/,
"'version information here'" => qr/to provide version information/,
);
not_in_file_ok(Changes =>
"placeholder date/time" => qr(Date/time)
);
module_boilerplate_ok('lib/Parse/Netstat/Colorizer.pm');
}