File Coverage

blib/lib/Net/Connection/Sort/host_l.pm
Criterion Covered Total %
statement 29 34 85.2
branch 4 8 50.0
condition 3 9 33.3
subroutine 7 7 100.0
pod 2 3 66.6
total 45 61 73.7


line stmt bran cond sub pod time code
1             package Net::Connection::Sort::host_l;
2              
3 2     2   190216 use 5.006;
  2         37  
4 2     2   11 use strict;
  2         4  
  2         51  
5 2     2   9 use warnings;
  2         4  
  2         52  
6 2     2   1138 use Net::IP;
  2         98714  
  2         843  
7              
8             =head1 NAME
9              
10             Net::Connection::Sort::host_l - Sorts the connections via the 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_l;
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.4',
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_l->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_l->new;
85              
86             =cut
87              
88             sub new{
89 1     1 1 1564 my %args;
90 1 50       4 if(defined($_[1])){
91 0         0 %args= %{$_[1]};
  0         0  
92             };
93              
94              
95 1         2 my $self = {
96             };
97 1         2 bless $self;
98              
99 1         3 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 322 my $self=$_[0];
116 1         2 my @objects;
117 1 50 33     9 if (
118             defined( $_[1] ) &&
119             ( ref($_[1]) eq 'ARRAY' )
120             ){
121 1         3 @objects=@{ $_[1] };
  1         3  
122             }else{
123 0         0 die 'The passed item is either not a array or undefined';
124             }
125              
126             @objects=sort {
127 1         6 &helper( $a->local_host ) <=> &helper( $b->local_host )
  4         95  
128             } @objects;
129              
130 1         31 return @objects;
131             }
132              
133             =head2 helper
134              
135             This is a internal function.
136              
137             =cut
138              
139             sub helper{
140 8 50 33 8 1 70 if (
      33        
141             ( !defined($_[0]) ) ||
142             ( $_[0] eq '*' ) ||
143             ( $_[0] =~ /[g-zG-Z]/ )
144             ){
145 0         0 return 0;
146             }
147 8         15 my $host=eval { Net::IP->new( $_[0] )->intip} ;
  8         22  
148 8 50       37583 if (!defined( $host )){
149 0         0 return 0;
150             }
151 8         30 return $host;
152             }
153              
154             =head1 AUTHOR
155              
156             Zane C. Bowers-Hadley, C<< >>
157              
158             =head1 BUGS
159              
160             Please report any bugs or feature requests to C, or through
161             the web interface at L. I will be notified, and then you'll
162             automatically be notified of progress on your bug as I make changes.
163              
164              
165              
166              
167             =head1 SUPPORT
168              
169             You can find documentation for this module with the perldoc command.
170              
171             perldoc Net::Connection::Sort
172              
173              
174             You can also look for information at:
175              
176             =over 4
177              
178             =item * RT: CPAN's request tracker (report bugs here)
179              
180             L
181              
182             =item * AnnoCPAN: Annotated CPAN documentation
183              
184             L
185              
186             =item * CPAN Ratings
187              
188             L
189              
190             =item * Search CPAN
191              
192             L
193              
194             =item * Git Repo
195              
196             L
197              
198             =back
199              
200              
201             =head1 ACKNOWLEDGEMENTS
202              
203              
204             =head1 LICENSE AND COPYRIGHT
205              
206             This software is Copyright (c) 2019 by Zane C. Bowers-Hadley.
207              
208             This is free software, licensed under:
209              
210             The Artistic License 2.0 (GPL Compatible)
211              
212              
213             =cut
214              
215             1; # End of Net::Connection::Sort