File Coverage

blib/lib/Net/Connection/Sort/ptr_f.pm
Criterion Covered Total %
statement 24 27 88.8
branch 4 6 66.6
condition 1 3 33.3
subroutine 6 6 100.0
pod 2 3 66.6
total 37 45 82.2


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