start work on local port stuff
This commit is contained in:
parent
181faa0fd7
commit
99283af7a2
|
|
@ -8,6 +8,8 @@ lib/Net/Connection/Sort/pid.pm
|
|||
lib/Net/Connection/Sort/proto.pm
|
||||
lib/Net/Connection/Sort/port_f.pm
|
||||
lib/Net/Connection/Sort/port_fa.pm
|
||||
lib/Net/Connection/Sort/port_l.pm
|
||||
lib/Net/Connection/Sort/port_la.pm
|
||||
lib/Net/Connection/Sort/ptr_f.pm
|
||||
lib/Net/Connection/Sort/ptr_l.pm
|
||||
lib/Net/Connection/Sort/state.pm
|
||||
|
|
@ -30,6 +32,8 @@ t/10-load.t
|
|||
t/11-load.t
|
||||
t/12-load.t
|
||||
t/13-load.t
|
||||
t/14-load.t
|
||||
t/15-load.t
|
||||
t/manifest.t
|
||||
t/pod-coverage.t
|
||||
t/pod.t
|
||||
|
|
@ -41,6 +45,8 @@ t/pid.t
|
|||
t/proto.t
|
||||
t/port_f.t
|
||||
t/port_fa.t
|
||||
t/port_l.t
|
||||
t/port_la.t
|
||||
t/ptr_f.t
|
||||
t/ptr_l.t
|
||||
t/state.t
|
||||
|
|
|
|||
|
|
@ -0,0 +1,195 @@
|
|||
package Net::Connection::Sort::port_l;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Net::Connection::Sort::port_l - Sorts the connections via the foreign port numerically.
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
Version 0.0.0
|
||||
|
||||
=cut
|
||||
|
||||
our $VERSION = '0.0.0';
|
||||
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This currently implements numeric sorting only. For non-numeric sorting using port_la.
|
||||
|
||||
use Net::Connection::Sort::port_l;
|
||||
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' => '23',
|
||||
'local_port' => '11132',
|
||||
'sendq' => '1',
|
||||
'recvq' => '0',
|
||||
'state' => 'ESTABLISHED',
|
||||
'proto' => 'tcp4',
|
||||
'ports' => 0,
|
||||
}),
|
||||
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',
|
||||
'ports' => 0,
|
||||
}),
|
||||
Net::Connection->new({
|
||||
'foreign_host' => '5.5.5.5',
|
||||
'local_host' => '6.6.6.6',
|
||||
'foreign_port' => '80',
|
||||
'local_port' => '11132',
|
||||
'sendq' => '1',
|
||||
'recvq' => '0',
|
||||
'state' => 'ESTABLISHED',
|
||||
'proto' => 'tcp4',
|
||||
'ports' => 0,
|
||||
}),
|
||||
Net::Connection->new({
|
||||
'foreign_host' => '3.3.3.3',
|
||||
'local_host' => '4.4.4.4',
|
||||
'foreign_port' => '21',
|
||||
'local_port' => '11132',
|
||||
'sendq' => '1',
|
||||
'recvq' => '0',
|
||||
'state' => 'ESTABLISHED',
|
||||
'proto' => 'tcp4',
|
||||
'ports' => 0,
|
||||
}),
|
||||
);
|
||||
|
||||
my $sorter=$sorter=Net::Connection::Sort::port_l->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::port_l->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';
|
||||
}
|
||||
|
||||
@objects=sort {
|
||||
$a->foreign_port <=> $b->foreign_port
|
||||
} @objects;
|
||||
|
||||
return @objects;
|
||||
}
|
||||
|
||||
=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
|
||||
|
|
@ -0,0 +1,206 @@
|
|||
package Net::Connection::Sort::port_la;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Net::Connection::Sort::port_la - Sorts the connections via the foreign port alphabetically.
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
Version 0.0.0
|
||||
|
||||
=cut
|
||||
|
||||
our $VERSION = '0.0.0';
|
||||
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
This currently implements cmp sorting only. For numeric sorting using port_f.
|
||||
|
||||
use Net::Connection::Sort::port_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' => 'FTP',
|
||||
'local_port' => '11132',
|
||||
'sendq' => '1',
|
||||
'recvq' => '0',
|
||||
'state' => 'ESTABLISHED',
|
||||
'proto' => 'tcp4',
|
||||
'ports' => 0,
|
||||
}),
|
||||
Net::Connection->new({
|
||||
'foreign_host' => '1.1.1.1',
|
||||
'local_host' => '2.2.2.2',
|
||||
'foreign_port' => 'SSH',
|
||||
'local_port' => '11132',
|
||||
'sendq' => '1',
|
||||
'recvq' => '0',
|
||||
'state' => 'ESTABLISHED',
|
||||
'proto' => 'tcp4',
|
||||
'ports' => 0,
|
||||
}),
|
||||
Net::Connection->new({
|
||||
'foreign_host' => '5.5.5.5',
|
||||
'local_host' => '6.6.6.6',
|
||||
'foreign_port' => 'HTTP',
|
||||
'local_port' => '11132',
|
||||
'sendq' => '1',
|
||||
'recvq' => '0',
|
||||
'state' => 'ESTABLISHED',
|
||||
'proto' => 'tcp4',
|
||||
'ports' => 0,
|
||||
}),
|
||||
Net::Connection->new({
|
||||
'foreign_host' => '3.3.3.3',
|
||||
'local_host' => '4.4.4.4',
|
||||
'foreign_port' => 'HTTPS',
|
||||
'local_port' => '11132',
|
||||
'sendq' => '1',
|
||||
'recvq' => '0',
|
||||
'state' => 'ESTABLISHED',
|
||||
'proto' => 'tcp4',
|
||||
'ports' => 0,
|
||||
}),
|
||||
);
|
||||
|
||||
my $sorter=$sorter=Net::Connection::Sort::port_la->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::port_la->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';
|
||||
}
|
||||
|
||||
@objects=sort {
|
||||
&helper( $a ) cmp &helper( $b )
|
||||
} @objects;
|
||||
|
||||
return @objects;
|
||||
}
|
||||
|
||||
=head2 helper
|
||||
|
||||
=cut
|
||||
|
||||
sub helper{
|
||||
if ( !defined( $_[0]->foreign_port_name ) ){
|
||||
return $_[0]->foreign_port;
|
||||
}
|
||||
return $_[0]->foreign_port_name;
|
||||
}
|
||||
|
||||
=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
|
||||
|
|
@ -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::port_l' ) || print "Bail out!\n";
|
||||
}
|
||||
|
||||
diag( "Testing Net::Connection::Sort::port_l $Net::Connection::Sort::port_l::VERSION, Perl $], $^X" );
|
||||
|
|
@ -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::port_la' ) || print "Bail out!\n";
|
||||
}
|
||||
|
||||
diag( "Testing Net::Connection::Sort::port_la $Net::Connection::Sort::port_la::VERSION, Perl $], $^X" );
|
||||
|
|
@ -0,0 +1,82 @@
|
|||
#!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' => '1',
|
||||
'local_port' => '11132',
|
||||
'sendq' => '1',
|
||||
'recvq' => '0',
|
||||
'state' => 'ESTABLISHED',
|
||||
'proto' => 'tcp4',
|
||||
'ports' => 0,
|
||||
}),
|
||||
Net::Connection->new({
|
||||
'foreign_host' => '1.1.1.1',
|
||||
'local_host' => '2.2.2.2',
|
||||
'foreign_port' => '80',
|
||||
'local_port' => '11132',
|
||||
'sendq' => '1',
|
||||
'recvq' => '0',
|
||||
'state' => 'ESTABLISHED',
|
||||
'proto' => 'tcp4',
|
||||
'ports' => 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',
|
||||
'ports' => 0,
|
||||
}),
|
||||
Net::Connection->new({
|
||||
'foreign_host' => '3.3.3.3',
|
||||
'local_host' => '4.4.4.4',
|
||||
'foreign_port' => '21',
|
||||
'local_port' => '11132',
|
||||
'sendq' => '1',
|
||||
'recvq' => '0',
|
||||
'state' => 'ESTABLISHED',
|
||||
'proto' => 'tcp4',
|
||||
'ports' => 0,
|
||||
}),
|
||||
);
|
||||
|
||||
BEGIN {
|
||||
use_ok( 'Net::Connection::Sort::port_l' ) || print "Bail out!\n";
|
||||
}
|
||||
|
||||
diag( "Testing Net::Connection::Sort::port_l $Net::Connection::Sort::port_l::VERSION, Perl $], $^X" );
|
||||
|
||||
my $sorter;
|
||||
my $worked=0;
|
||||
eval{
|
||||
$sorter=Net::Connection::Sort::port_l->new;
|
||||
$worked=1;
|
||||
};
|
||||
ok( $worked eq 1, 'sorter init') or die ('Net::Connection::Sort::port_l->new resulted in... '.$@);
|
||||
|
||||
my @sorted;
|
||||
$worked=0;
|
||||
eval{
|
||||
@sorted=$sorter->sorter( \@objects );
|
||||
$worked=1;
|
||||
};
|
||||
ok( $worked eq 1, 'sort') or die ('Net::Connection::Sort::host_f->sorter(@objects) resulted in... '.$@);
|
||||
|
||||
ok( $sorted[0]->foreign_port eq '1', 'sort order 0') or die ('The first foreign port value was not 1');
|
||||
ok( $sorted[1]->foreign_port eq '21', 'sort order 1') or die ('The last foreign port value was not 21');
|
||||
ok( $sorted[2]->foreign_port eq '22', 'sort order 2') or die ('The middle foreign port value was not 22');
|
||||
ok( $sorted[3]->foreign_port eq '80' , 'sort order 2') or die ('The middle foreign port value was not 80');
|
||||
|
||||
done_testing(7);
|
||||
|
|
@ -0,0 +1,82 @@
|
|||
#!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' => 'FTP',
|
||||
'local_port' => '11132',
|
||||
'sendq' => '1',
|
||||
'recvq' => '0',
|
||||
'state' => 'ESTABLISHED',
|
||||
'proto' => 'tcp4',
|
||||
'ports' => 0,
|
||||
}),
|
||||
Net::Connection->new({
|
||||
'foreign_host' => '1.1.1.1',
|
||||
'local_host' => '2.2.2.2',
|
||||
'foreign_port' => 'HTTP',
|
||||
'local_port' => '11132',
|
||||
'sendq' => '1',
|
||||
'recvq' => '0',
|
||||
'state' => 'ESTABLISHED',
|
||||
'proto' => 'tcp4',
|
||||
'ports' => 0,
|
||||
}),
|
||||
Net::Connection->new({
|
||||
'foreign_host' => '5.5.5.5',
|
||||
'local_host' => '6.6.6.6',
|
||||
'foreign_port' => 'SSH',
|
||||
'local_port' => '11132',
|
||||
'sendq' => '1',
|
||||
'recvq' => '0',
|
||||
'state' => 'ESTABLISHED',
|
||||
'proto' => 'tcp4',
|
||||
'ports' => 0,
|
||||
}),
|
||||
Net::Connection->new({
|
||||
'foreign_host' => '3.3.3.3',
|
||||
'local_host' => '4.4.4.4',
|
||||
'foreign_port' => 'HTTPS',
|
||||
'local_port' => '11132',
|
||||
'sendq' => '1',
|
||||
'recvq' => '0',
|
||||
'state' => 'ESTABLISHED',
|
||||
'proto' => 'tcp4',
|
||||
'ports' => 0,
|
||||
}),
|
||||
);
|
||||
|
||||
BEGIN {
|
||||
use_ok( 'Net::Connection::Sort::port_la' ) || print "Bail out!\n";
|
||||
}
|
||||
|
||||
diag( "Testing Net::Connection::Sort::port_la $Net::Connection::Sort::port_la::VERSION, Perl $], $^X" );
|
||||
|
||||
my $sorter;
|
||||
my $worked=0;
|
||||
eval{
|
||||
$sorter=Net::Connection::Sort::port_la->new;
|
||||
$worked=1;
|
||||
};
|
||||
ok( $worked eq 1, 'sorter init') or die ('Net::Connection::Sort::port_la->new resulted in... '.$@);
|
||||
|
||||
my @sorted;
|
||||
$worked=0;
|
||||
eval{
|
||||
@sorted=$sorter->sorter( \@objects );
|
||||
$worked=1;
|
||||
};
|
||||
ok( $worked eq 1, 'sort') or die ('Net::Connection::Sort::host_f->sorter(@objects) resulted in... '.$@);
|
||||
|
||||
ok( $sorted[0]->foreign_port =~ 'FTP', 'sort order 0') or die ('The first foreign port value was not FTP');
|
||||
ok( $sorted[1]->foreign_port =~ 'HTTP', 'sort order 1') or die ('The last foreign port value was not HTTP');
|
||||
ok( $sorted[2]->foreign_port =~ 'HTTPS', 'sort order 2') or die ('The middle foreign port value was not HTTPS');
|
||||
ok( $sorted[3]->foreign_port =~ 'SSH' , 'sort order 2') or die ('The middle foreign port value was not SSH');
|
||||
|
||||
done_testing(7);
|
||||
Loading…
Reference in New Issue