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

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

View File

@ -17,12 +17,11 @@ my %WriteMakefileArgs = (
'Test::More' => '0',
},
PREREQ_PM => {
#'ABC' => '1.6',
#'Foo::Bar::Module' => '5.0401',
'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);

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 $foo = Net::Connection::Sort->new();
...
my $sort_args={
type=>'host_f',
invert=>0,
};
=head1 EXPORT
my $mcs;
eval{
$ncs=Net::Connection::Sort->new( $sort_args );
};
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.
if ( ! defined( $mcs ) ){
print "Failed to init the sorter... ".$@;
}
=head1 SUBROUTINES/METHODS
=head1 METHODS
=head2 function1
=head2 new
This initiates the module.
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.
'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

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

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" );

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" );