File Coverage

blib/lib/Net/Connection/Sort/host_fl.pm
Criterion Covered Total %
statement 29 34 85.2
branch 5 10 50.0
condition 3 9 33.3
subroutine 7 7 100.0
pod 2 3 66.6
total 46 63 73.0


line stmt bran cond sub pod time code
1             package Net::Connection::Sort::host_fl;
2              
3 2     2   226905 use 5.006;
  2         47  
4 2     2   13 use strict;
  2         4  
  2         49  
5 2     2   17 use warnings;
  2         8  
  2         69  
6 2     2   1451 use Net::IP;
  2         119767  
  2         1145  
7              
8             =head1 NAME
9              
10             Net::Connection::Sort::host_fl - Sorts the connections via the foreign host and then local host.
11              
12             =head1 VERSION
13              
14             Version 0.0.0
15              
16             =cut
17              
18             our $VERSION = '0.0.0';
19              
20              
21             =head1 SYNOPSIS
22              
23             use Net::Connection::Sort::host_fl;
24             use Net::Connection;
25             use Data::Dumper;
26            
27             my @objects=(
28             Net::Connection->new({
29             'foreign_host' => '3.3.3.3',
30             'local_host' => '4.4.4.5',
31             'foreign_port' => '22',
32             'local_port' => '11132',
33             'sendq' => '1',
34             'recvq' => '0',
35             'state' => 'ESTABLISHED',
36             'proto' => 'tcp4'
37             }),
38             Net::Connection->new({
39             'foreign_host' => '1.1.1.1',
40             'local_host' => '2.2.2.2',
41             'foreign_port' => '22',
42             'local_port' => '11132',
43             'sendq' => '1',
44             'recvq' => '0',
45             'state' => 'ESTABLISHED',
46             'proto' => 'tcp4'
47             }),
48             Net::Connection->new({
49             'foreign_host' => '5.5.5.5',
50             'local_host' => '6.6.6.6',
51             'foreign_port' => '22',
52             'local_port' => '11132',
53             'sendq' => '1',
54             'recvq' => '0',
55             'state' => 'ESTABLISHED',
56             'proto' => 'tcp4'
57             }),
58             Net::Connection->new({
59             'foreign_host' => '3.3.3.3',
60             'local_host' => '4.4.4.4',
61             'foreign_port' => '22',
62             'local_port' => '11132',
63             'sendq' => '1',
64             'recvq' => '0',
65             'state' => 'ESTABLISHED',
66             'proto' => 'tcp4'
67             }),
68             );
69            
70             my $sorter=$sorter=Net::Connection::Sort::host_fl->new;
71            
72             @objects=$sorter->sorter( \@objects );
73            
74             print Dumper( \@objects );
75              
76             =head1 METHODS
77              
78             =head2 new
79              
80             This initiates the module.
81              
82             No arguments are taken and this will always succeed.
83              
84             my $sorter=$sorter=Net::Connection::Sort::host_fl->new;
85              
86             =cut
87              
88             sub new{
89 1     1 1 1952 my %args;
90 1 50       5 if(defined($_[1])){
91 0         0 %args= %{$_[1]};
  0         0  
92             };
93              
94              
95 1         3 my $self = {
96             };
97 1         9 bless $self;
98              
99 1         5 return $self;
100             }
101              
102             =head2 sort
103              
104             This sorts the array of Net::Connection objects.
105              
106             One object is taken and that is a array of objects.
107              
108             @objects=$sorter->sorter( \@objects );
109            
110             print Dumper( \@objects );
111              
112             =cut
113              
114             sub sorter{
115 1     1 0 370 my $self=$_[0];
116 1         2 my @objects;
117 1 50 33     18 if (
118             defined( $_[1] ) &&
119             ( ref($_[1]) eq 'ARRAY' )
120             ){
121 1         2 @objects=@{ $_[1] };
  1         4  
122             }else{
123 0         0 die 'The passed item is either not a array or undefined';
124             }
125              
126             @objects=sort {
127 1         5 &helper( $a->{foreign_host} ) <=> &helper( $b->{foreign_host} ) or
128             &helper( $a->{local_host} ) <=> &helper( $b->{local_host} )
129 4 50       119 } @objects;
130              
131 1         35 return @objects;
132             }
133              
134             =head2 helper
135              
136             This is a internal function.
137              
138             =cut
139              
140             sub helper{
141 10 50 33 10 1 100 if (
      33        
142             ( !defined($_[0]) ) ||
143             ( $_[0] eq '*' ) ||
144             ( $_[0] =~ /[g-zG-Z]/ )
145             ){
146 0         0 return 0;
147             }
148 10         19 my $host=eval { Net::IP->new( $_[0] )->intip} ;
  10         36  
149 10 50       55126 if (!defined( $host )){
150 0         0 return 0;
151             }
152 10         53 return $host;
153             }
154              
155             =head1 AUTHOR
156              
157             Zane C. Bowers-Hadley, C<< >>
158              
159             =head1 BUGS
160              
161             Please report any bugs or feature requests to C, or through
162             the web interface at L. I will be notified, and then you'll
163             automatically be notified of progress on your bug as I make changes.
164              
165              
166              
167              
168             =head1 SUPPORT
169              
170             You can find documentation for this module with the perldoc command.
171              
172             perldoc Net::Connection::Sort
173              
174              
175             You can also look for information at:
176              
177             =over 4
178              
179             =item * RT: CPAN's request tracker (report bugs here)
180              
181             L
182              
183             =item * AnnoCPAN: Annotated CPAN documentation
184              
185             L
186              
187             =item * CPAN Ratings
188              
189             L
190              
191             =item * Search CPAN
192              
193             L
194              
195             =item * Git Repo
196              
197             L
198              
199             =back
200              
201              
202             =head1 ACKNOWLEDGEMENTS
203              
204              
205             =head1 LICENSE AND COPYRIGHT
206              
207             This software is Copyright (c) 2019 by Zane C. Bowers-Hadley.
208              
209             This is free software, licensed under:
210              
211             The Artistic License 2.0 (GPL Compatible)
212              
213              
214             =cut
215              
216             1; # End of Net::Connection::Sort