vvelox
/
Net-Connection-Sort
mirror of https://github.com/VVelox/Net-Connection-Sort.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

begin work on user

This commit is contained in:
Zane C. B-H 2019-07-23 23:21:02 -05:00
parent e440126bc2
commit fff4731c85
4 changed files with 336 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Net-Connection-Sort/MANIFEST
View File

@ -8,6 +8,7 @@ lib/Net/Connection/Sort/pid.pm
lib/Net/Connection/Sort/proto.pm
lib/Net/Connection/Sort/state.pm
lib/Net/Connection/Sort/uid.pm
lib/Net/Connection/Sort/user.pm
Makefile.PL
MANIFEST This list of files
README
@ -20,6 +21,7 @@ t/05-load.t
t/06-load.t
t/07-load.t
t/08-load.t
t/09-load.t
t/manifest.t
t/pod-coverage.t
t/pod.t
@ -30,4 +32,5 @@ t/host_lf.t
t/pid.t
t/proto.t
t/state.t
t/uid.t
t/uid.t
t/user.t

216
Net-Connection-Sort/lib/Net/Connection/Sort/user.pm Normal file
View File

@ -0,0 +1,216 @@
package Net::Connection::Sort::pid;
use 5.006;
use strict;
use warnings;
=head1 NAME
Net::Connection::Sort::pid - Sorts the connections via the PID.
=head1 VERSION
Version 0.0.0
=cut
our $VERSION = '0.0.0';
=head1 SYNOPSIS
Please keep in mind that PID is not a requirement and if not specified is set to 0,
meaning it will show up earlier.
use Net::Connection::Sort::host_f;
use Net::Connection;
use Data::Dumper;
my @objects=(
Net::Connection->new({
'foreign_host' => '3.3.3.3',
'local_host' => '4.4.4.4',
'foreign_port' => '22',
'local_port' => '11132',
'sendq' => '1',
'recvq' => '0',
'state' => 'ESTABLISHED',
'proto' => 'tcp4',
'uid' => 22,
'pid' => 2,
}),
Net::Connection->new({
'foreign_host' => '1.1.1.1',
'local_host' => '2.2.2.2',
'foreign_port' => '22',
'local_port' => '11132',
'sendq' => '1',
'recvq' => '0',
'state' => 'ESTABLISHED',
'proto' => 'tcp4',
'uid' => 1000,
'pid' => 0,
}),
Net::Connection->new({
'foreign_host' => '5.5.5.5',
'local_host' => '6.6.6.6',
'foreign_port' => '22',
'local_port' => '11132',
'sendq' => '1',
'recvq' => '0',
'state' => 'ESTABLISHED',
'proto' => 'tcp4',
'uid' => 1,
'pid' => 44,
}),
# as no PID is specified, the value of 0 will just be used instead
Net::Connection->new({
'foreign_host' => '3.3.3.3',
'local_host' => '4.4.4.4',
'foreign_port' => '22',
'local_port' => '11132',
'sendq' => '1',
'recvq' => '0',
'state' => 'ESTABLISHED',
'proto' => 'tcp4',
}),
);
my $sorter=$sorter=Net::Connection::Sort::uid->new;
@objects=$sorter->sorter( \@objects );
print Dumper( \@objects );
=head1 METHODS
=head2 new
This initiates the module.
No arguments are taken and this will always succeed.
my $sorter=$sorter=Net::Connection::Sort::uid->new;
=cut
sub new{
my %args;
if(defined($_[1])){
%args= %{$_[1]};
};
my $self = {
};
bless $self;
return $self;
}
=head2 sort
This sorts the array of Net::Connection objects.
One object is taken and that is a array of objects.
@objects=$sorter->sorter( \@objects );
print Dumper( \@objects );
=cut
sub sorter{
my $self=$_[0];
my @objects;
if (
defined( $_[1] ) &&
( ref($_[1]) eq 'ARRAY' )
){
@objects=@{ $_[1] };
}else{
die 'The passed item is either not a array or undefined';
}
# whoops... just realized I forgot to create a method for this in Net::Connection... doing it this way foreign
# compatibility with Net::Connection 0.0.0 as of currently
@objects=sort {
&helper( $a->{pid} ) <=> &helper( $b->{pid} )
} @objects;
return @objects;
}
=head2 helper
This is a internal function.
If no PID is defined, returns 0.
=cut
sub helper{
if ( !defined($_[0]) ){
return 0;
}
return $_[0];
}
=head1 AUTHOR
Zane C. Bowers-Hadley, C<< <vvelox at vvelox.net> >>
=head1 BUGS
Please report any bugs or feature requests to C<bug-net-connection-sort at rt.cpan.org>, or through
the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-Connection-Sort>. 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 Net::Connection::Sort
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker (report bugs here)
L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-Connection-Sort>
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/Net-Connection-Sort>
=item * CPAN Ratings
L<https://cpanratings.perl.org/d/Net-Connection-Sort>
=item * Search CPAN
L<https://metacpan.org/release/Net-Connection-Sort>
=back
=head1 ACKNOWLEDGEMENTS
=head1 LICENSE AND COPYRIGHT
This software is Copyright (c) 2019 by Zane C. Bowers-Hadley.
This is free software, licensed under:
The Artistic License 2.0 (GPL Compatible)
=cut
1; # End of Net::Connection::Sort

13
Net-Connection-Sort/t/09-load.t Normal file
View File

@ -0,0 +1,13 @@
#!perl -T
use 5.006;
use strict;
use warnings;
use Test::More;
plan tests => 1;
BEGIN {
use_ok( 'Net::Connection::Sort::user' ) || print "Bail out!\n";
}
diag( "Testing Net::Connection::Sort::user $Net::Connection::Sort::user::VERSION, Perl $], $^X" );

103
Net-Connection-Sort/t/user.t Normal file
View File

@ -0,0 +1,103 @@
#!perl -T
use 5.006;
use strict;
use warnings;
use Test::More;
use Net::Connection;
my @objects=(
Net::Connection->new({
'foreign_host' => '3.3.3.3',
'local_host' => '4.4.4.4',
'foreign_port' => '22',
'local_port' => '11132',
'sendq' => '1',
'recvq' => '0',
'state' => 'LISTEN',
'proto' => 'tcp6',
'uid' => 1000,
'pid' => 2,
}),
Net::Connection->new({
'foreign_host' => '1.1.1.1',
'local_host' => '2.2.2.2',
'foreign_port' => '22',
'local_port' => '11132',
'sendq' => '1',
'recvq' => '0',
'state' => 'FIN_WAIT_2',
'proto' => 'udp4',
'uid' => 33,
'pid' => 0,
}),
Net::Connection->new({
'foreign_host' => '5.5.5.5',
'local_host' => '6.6.6.6',
'foreign_port' => '22',
'local_port' => '11132',
'sendq' => '1',
'recvq' => '0',
'state' => 'TIME_WAIT',
'proto' => 'udp6',
'uid' => 0,
'pid' => 1,
}),
Net::Connection->new({
'foreign_host' => '3.3.3.3',
'local_host' => '4.4.4.4',
'foreign_port' => '22',
'local_port' => '11132',
'sendq' => '1',
'recvq' => '0',
'state' => 'ESTABLISHED',
'proto' => 'tcp4',
}),
);
BEGIN {
use_ok( 'Net::Connection::Sort::user' ) || print "Bail out!\n";
}
diag( "Testing Net::Connection::Sort::user $Net::Connection::Sort::user::VERSION, Perl $], $^X" );
my $sorter;
my $worked=0;
eval{
$sorter=Net::Connection::Sort::user->new;
$worked=1;
};
ok( $worked eq 1, 'sorter init') or die ('Net::Connection::Sort::user->new resulted in... '.$@);
my @sorted;
$worked=0;
eval{
@sorted=$sorter->sorter( \@objects );
$worked=1;
};
ok( $worked eq 1, 'sort') or die ('Net::Connection::Sort::proto->sorter(@objects) resulted in... '.$@);
# 0 and 1 can end up in any order, make sure they are as expected
my $is_defined=1;
if( !defined( $sorted[0]->{pid} ) ||
!defined( $sorted[1]->{pid} )
){
$is_defined=0;
}
my $is_zero=0;
if( (
defined( $sorted[0]->{pid} ) &&
( $sorted[0]->{pid} eq '0' )
) || (
defined( $sorted[1]->{pid} ) &&
( $sorted[1]->{pid} eq '0' )
)
){
$is_zero=1;
}
ok( $is_defined eq '0', 'sort order 0') or die ('The PID for 0/1 is not 0');
ok( $is_zero eq '1', 'sort order 1') or die ('The PID for 0/1 is not 0');
ok( $sorted[2]->{pid} eq '1', 'sort order 2') or die ('The PID for 2 is not 33');
ok( $sorted[3]->{pid} eq '2', 'sort order 2') or die ('The PID for 3 is not 1000');
done_testing(7);