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 host_f and Sort mostly done

This commit is contained in:
Zane C. B-H 2019-07-23 01:30:43 -05:00
parent 4f7373d9ba
commit a0ef786189
6 changed files with 303 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Net-Connection-Sort/MANIFEST
View File

@ -1,9 +1,12 @@
Changes
lib/Net/Connection/Sort.pm
lib/Net/Connection/Sort/host_f.pm
Makefile.PL
MANIFEST This list of files
README
t/00-load.t
t/01-load.t
t/manifest.t
t/pod-coverage.t
t/pod.t
t/host_f.t

43
Net-Connection-Sort/Makefile.PL
View File

@ -4,25 +4,24 @@ use warnings;
use ExtUtils::MakeMaker;
my %WriteMakefileArgs = (
NAME => 'Net::Connection::Sort',
AUTHOR => q{Zane C. Bowers-Hadley <vvelox@vvelox.net>},
VERSION_FROM => 'lib/Net/Connection/Sort.pm',
ABSTRACT_FROM => 'lib/Net/Connection/Sort.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 => 'Net-Connection-Sort-*' },
);
NAME => 'Net::Connection::Sort',
AUTHOR => q{Zane C. Bowers-Hadley <vvelox@vvelox.net>},
VERSION_FROM => 'lib/Net/Connection/Sort.pm',
ABSTRACT_FROM => 'lib/Net/Connection/Sort.pm',
LICENSE => 'artistic_2',
MIN_PERL_VERSION => '5.006',
CONFIGURE_REQUIRES => {
'ExtUtils::MakeMaker' => '0',
},
TEST_REQUIRES => {
'Test::More' => '0',
},
PREREQ_PM => {
'Net::Connection'=>'0.0.0',
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'Net-Connection-Sort-*' },
);
# Compatibility with old versions of ExtUtils::MakeMaker
unless (eval { ExtUtils::MakeMaker->VERSION('6.64'); 1 }) {
@ -36,10 +35,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);

116
Net-Connection-Sort/lib/Net/Connection/Sort.pm
View File

@ -3,50 +3,132 @@ package Net::Connection::Sort;
use 5.006;
use strict;
use warnings;
use base 'Error::Helper';
=head1 NAME
Net::Connection::Sort - The great new Net::Connection::Sort!
Net::Connection::Sort - Sorts array of Net::Connection objects.
=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 Net::Connection::Sort;
use Net::Connection;
my $sort_args={
type=>'host_f',
invert=>0,
};
my $mcs;
eval{
$ncs=Net::Connection::Sort->new( $sort_args );
};
if ( ! defined( $mcs ) ){
print "Failed to init the sorter... ".$@;
}
my $foo = Net::Connection::Sort->new();
...
=head1 METHODS
=head1 EXPORT
=head2 new
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.
This initiates the module.
=head1 SUBROUTINES/METHODS
One argument is taken and that is a hash ref with two possible keys,
'type' and 'invert'. If not passed or any of the keys are undef, then
the defaults will be used.
=head2 function1
'type' is the module to use. It is relative to 'Net::Connection::Sort',
so 'host_f' becomes 'Net::Connection::Sort::host_f'.
my $sort_args={
type=>'host_f',
invert=>0,
};
my $mcs;
eval{
$ncs=Net::Connection::Sort->new( $sort_args );
};
if ( ! defined( $mcs ) ){
print "Failed to init the sorter... ".$@;
}
=cut
sub function1 {
sub new{
my %args;
if(defined($_[1])){
%args= %{$_[1]};
};
my $self = {
perror=>undef,
error=>undef,
errorString=>"",
testing=>0,
errorExtra=>{
flags=>{
}
},
type=>'host_f',
invert=>0,
sorter=>undef,,
};
bless $self;
# real in the args if needed
if (defined( $args{type} )){
$self->{type}=$args{type};
}
if (defined( $args{invert} )){
$self->{invert}=$args{invert};
}
# see of we amd reel in the module
my $to_eval='use Net::Connection::Sort::'.$self->{type}
.'; $self->{sorter}=Net::Connection::Sort::'.$self->{type}.'->new;';
eval( $to_eval ) or die('Failed to use or invoke Net::Connection::Sort::'.$self->{type}.'->new... '.$@);
# make sure we did get it
if (!defined( $self->{sorter} )){
die( 'Net::Connection::Sort::'.$self->{type}.'->new returned undef');
}
return $self;
}
=head2 function2
=head2 sort
This sorts the array of Net::Connection objects.
One object is taken and that is a array of objects.
=cut
sub function2 {
sub sorter{
my $self=$_[0];
my @objects;
if(defined($_[1])){
@objects= @{$_[1]};
};
if( ! $self->errorblank ){
return undef;
}
return $self->{sorter}->sorter( \@objects );
}
=head1 AUTHOR

154
Net-Connection-Sort/lib/Net/Connection/Sort/host_f.pm Normal file
View File

@ -0,0 +1,154 @@
package Net::Connection::Sort::host_f;
use 5.006;
use strict;
use warnings;
=head1 NAME
Net::Connection::Sort - Sorts array of Net::Connection objects.
=head1 VERSION
Version 0.0.0
=cut
our $VERSION = '0.0.0';
=head1 SYNOPSIS
use Net::Connection::Sort::host_f;
use Net::Connection;
my $ncs=Net::Connection::Sort::host_f->new;
=head1 METHODS
=head2 new
This initiates the module.
No arguments are taken and this will always succeed.
=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.
=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->foreign_host ) <=> &helper( $b->foreign_host )
} @objects;
return @objects;
}
=head2 helper
=cut
sub helper{
if (
( !defined($_[0]) ) ||
( $_[0] eq '*' ) ||
( $_[0] =~ /[g-zG-Z]/ )
){
return 0;
}
my $host=eval { Net::IP->new( $_[0] )->intip} ;
if (!defined( $host )){
return 0;
}
return $host;
}
=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/01-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::host_f' ) || print "Bail out!\n";
}
diag( "Testing Net::Connection::Sort::host_f $Net::Connection::Sort::host_f::VERSION, Perl $], $^X" );

13
Net-Connection-Sort/t/host_f.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::host_f' ) || print "Bail out!\n";
}
diag( "Testing Net::Connection::Sort::host_f $Net::Connection::Sort::host_f::VERSION, Perl $], $^X" );