begin work on host_f and Sort mostly done
This commit is contained in:
parent
4f7373d9ba
commit
a0ef786189
|
@ -1,9 +1,12 @@
|
||||||
Changes
|
Changes
|
||||||
lib/Net/Connection/Sort.pm
|
lib/Net/Connection/Sort.pm
|
||||||
|
lib/Net/Connection/Sort/host_f.pm
|
||||||
Makefile.PL
|
Makefile.PL
|
||||||
MANIFEST This list of files
|
MANIFEST This list of files
|
||||||
README
|
README
|
||||||
t/00-load.t
|
t/00-load.t
|
||||||
|
t/01-load.t
|
||||||
t/manifest.t
|
t/manifest.t
|
||||||
t/pod-coverage.t
|
t/pod-coverage.t
|
||||||
t/pod.t
|
t/pod.t
|
||||||
|
t/host_f.t
|
||||||
|
|
|
@ -4,25 +4,24 @@ use warnings;
|
||||||
use ExtUtils::MakeMaker;
|
use ExtUtils::MakeMaker;
|
||||||
|
|
||||||
my %WriteMakefileArgs = (
|
my %WriteMakefileArgs = (
|
||||||
NAME => 'Net::Connection::Sort',
|
NAME => 'Net::Connection::Sort',
|
||||||
AUTHOR => q{Zane C. Bowers-Hadley <vvelox@vvelox.net>},
|
AUTHOR => q{Zane C. Bowers-Hadley <vvelox@vvelox.net>},
|
||||||
VERSION_FROM => 'lib/Net/Connection/Sort.pm',
|
VERSION_FROM => 'lib/Net/Connection/Sort.pm',
|
||||||
ABSTRACT_FROM => 'lib/Net/Connection/Sort.pm',
|
ABSTRACT_FROM => 'lib/Net/Connection/Sort.pm',
|
||||||
LICENSE => 'artistic_2',
|
LICENSE => 'artistic_2',
|
||||||
MIN_PERL_VERSION => '5.006',
|
MIN_PERL_VERSION => '5.006',
|
||||||
CONFIGURE_REQUIRES => {
|
CONFIGURE_REQUIRES => {
|
||||||
'ExtUtils::MakeMaker' => '0',
|
'ExtUtils::MakeMaker' => '0',
|
||||||
},
|
},
|
||||||
TEST_REQUIRES => {
|
TEST_REQUIRES => {
|
||||||
'Test::More' => '0',
|
'Test::More' => '0',
|
||||||
},
|
},
|
||||||
PREREQ_PM => {
|
PREREQ_PM => {
|
||||||
#'ABC' => '1.6',
|
'Net::Connection'=>'0.0.0',
|
||||||
#'Foo::Bar::Module' => '5.0401',
|
},
|
||||||
},
|
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
|
||||||
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
|
clean => { FILES => 'Net-Connection-Sort-*' },
|
||||||
clean => { FILES => 'Net-Connection-Sort-*' },
|
);
|
||||||
);
|
|
||||||
|
|
||||||
# Compatibility with old versions of ExtUtils::MakeMaker
|
# Compatibility with old versions of ExtUtils::MakeMaker
|
||||||
unless (eval { ExtUtils::MakeMaker->VERSION('6.64'); 1 }) {
|
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}
|
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}
|
delete $WriteMakefileArgs{MIN_PERL_VERSION}
|
||||||
unless eval { ExtUtils::MakeMaker->VERSION('6.48'); 1 };
|
unless eval { ExtUtils::MakeMaker->VERSION('6.48'); 1 };
|
||||||
delete $WriteMakefileArgs{LICENSE}
|
delete $WriteMakefileArgs{LICENSE}
|
||||||
unless eval { ExtUtils::MakeMaker->VERSION('6.31'); 1 };
|
unless eval { ExtUtils::MakeMaker->VERSION('6.31'); 1 };
|
||||||
|
|
||||||
WriteMakefile(%WriteMakefileArgs);
|
WriteMakefile(%WriteMakefileArgs);
|
||||||
|
|
|
@ -3,50 +3,132 @@ package Net::Connection::Sort;
|
||||||
use 5.006;
|
use 5.006;
|
||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
|
use base 'Error::Helper';
|
||||||
|
|
||||||
=head1 NAME
|
=head1 NAME
|
||||||
|
|
||||||
Net::Connection::Sort - The great new Net::Connection::Sort!
|
Net::Connection::Sort - Sorts array of Net::Connection objects.
|
||||||
|
|
||||||
=head1 VERSION
|
=head1 VERSION
|
||||||
|
|
||||||
Version 0.01
|
Version 0.0.0
|
||||||
|
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
our $VERSION = '0.01';
|
our $VERSION = '0.0.0';
|
||||||
|
|
||||||
|
|
||||||
=head1 SYNOPSIS
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
Quick summary of what the module does.
|
|
||||||
|
|
||||||
Perhaps a little code snippet.
|
|
||||||
|
|
||||||
use Net::Connection::Sort;
|
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
|
This initiates the module.
|
||||||
if you don't export anything, such as for a purely object-oriented 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
|
=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
|
=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
|
=head1 AUTHOR
|
||||||
|
|
|
@ -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
|
|
@ -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" );
|
|
@ -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" );
|
Loading…
Reference in New Issue