File Coverage

blib/lib/Net/Connection/Sort.pm
Criterion Covered Total %
statement 8 31 25.8
branch 0 14 0.0
condition n/a
subroutine 3 5 60.0
pod 2 2 100.0
total 13 52 25.0


line stmt bran cond sub pod time code
1             package Net::Connection::Sort;
2              
3 1     1   65496 use 5.006;
  1         4  
4 1     1   8 use strict;
  1         3  
  1         20  
5 1     1   5 use warnings;
  1         2  
  1         353  
6              
7             =head1 NAME
8              
9             Net::Connection::Sort - Sorts array of Net::Connection objects.
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             use Net::Connection::Sort;
23             use Net::Connection;
24             use Data::Dumper;
25            
26             my @objects=(
27             Net::Connection->new({
28             'foreign_host' => '3.3.3.3',
29             'local_host' => '4.4.4.4',
30             'foreign_port' => '22',
31             'local_port' => '11132',
32             'sendq' => '1',
33             'recvq' => '0',
34             'state' => 'ESTABLISHED',
35             'proto' => 'tcp4'
36             }),
37             Net::Connection->new({
38             'foreign_host' => '1.1.1.1',
39             'local_host' => '2.2.2.2',
40             'foreign_port' => '22',
41             'local_port' => '11132',
42             'sendq' => '1',
43             'recvq' => '0',
44             'state' => 'ESTABLISHED',
45             'proto' => 'tcp4'
46             }),
47             Net::Connection->new({
48             'foreign_host' => '5.5.5.5',
49             'local_host' => '6.6.6.6',
50             'foreign_port' => '22',
51             'local_port' => '11132',
52             'sendq' => '1',
53             'recvq' => '0',
54             'state' => 'ESTABLISHED',
55             'proto' => 'tcp4'
56             }),
57             Net::Connection->new({
58             'foreign_host' => '3.3.3.3',
59             'local_host' => '4.4.4.4',
60             'foreign_port' => '22',
61             'local_port' => '11132',
62             'sendq' => '1',
63             'recvq' => '0',
64             'state' => 'ESTABLISHED',
65             'proto' => 'tcp4'
66             }),
67             );
68            
69             my $sort_args={
70             type=>'host_f',
71             invert=>0,
72             };
73            
74             my $mcs;
75             eval{
76             $mcs=Net::Connection::Sort->new( $sort_args );
77             };
78            
79             if ( ! defined( $mcs ) ){
80             print "Failed to init the sorter... ".$@;
81             }
82            
83             my @sorted=$mcs->sorter( \@objects );
84            
85             print Dumper( \@sorted );
86              
87             =head1 METHODS
88              
89             =head2 new
90              
91             This initiates the module.
92              
93             One argument is taken and that is a hash ref with two possible keys,
94             'type' and 'invert'. If not passed or any of the keys are undef, then
95             the defaults will be used.
96              
97             'type' is the module to use. It is relative to 'Net::Connection::Sort',
98             so 'host_f' becomes 'Net::Connection::Sort::host_f'.
99              
100             my $sort_args={
101             type=>'host_f',
102             invert=>0,
103             };
104            
105             my $mcs;
106             eval{
107             $ncs=Net::Connection::Sort->new( $sort_args );
108             };
109            
110             if ( ! defined( $mcs ) ){
111             print "Failed to init the sorter... ".$@;
112             }
113              
114             =cut
115              
116             sub new{
117 0     0 1   my %args;
118 0 0         if(defined($_[1])){
119 0           %args= %{$_[1]};
  0            
120             };
121              
122              
123 0           my $self = {
124             testing=>0,
125             type=>'host_f',
126             invert=>0,
127             sorter=>undef,,
128             };
129 0           bless $self;
130              
131             # real in the args if needed
132 0 0         if (defined( $args{type} )){
133 0           $self->{type}=$args{type};
134             }
135 0 0         if (defined( $args{invert} )){
136 0           $self->{invert}=$args{invert};
137             }
138              
139             # see of we amd reel in the module
140             my $to_eval='use Net::Connection::Sort::'.$self->{type}
141 0           .'; $self->{sorter}=Net::Connection::Sort::'.$self->{type}.'->new;';
142 0 0         eval( $to_eval ) or die('Failed to use or invoke Net::Connection::Sort::'.$self->{type}.'->new... '.$@);
143              
144             # make sure we did get it
145 0 0         if (!defined( $self->{sorter} )){
146 0           die( 'Net::Connection::Sort::'.$self->{type}.'->new returned undef');
147             }
148              
149 0           return $self;
150             }
151              
152             =head2 sorter
153              
154             This sorts the array of Net::Connection objects.
155              
156             One object is taken and that is a array of objects.
157              
158             my @sorted=$mcs->sorter( \@objects );
159            
160             print Dumper( \@sorted );
161              
162             =cut
163              
164             sub sorter{
165 0     0 1   my $self=$_[0];
166 0           my @objects;
167 0 0         if(defined($_[1])){
168 0           @objects= @{$_[1]};
  0            
169             };
170              
171 0 0         if( ! $self->errorblank ){
172 0           return undef;
173             }
174              
175 0           return $self->{sorter}->sorter( \@objects );
176             }
177              
178             =head1 AUTHOR
179              
180             Zane C. Bowers-Hadley, C<< >>
181              
182             =head1 BUGS
183              
184             Please report any bugs or feature requests to C, or through
185             the web interface at L. I will be notified, and then you'll
186             automatically be notified of progress on your bug as I make changes.
187              
188              
189              
190              
191             =head1 SUPPORT
192              
193             You can find documentation for this module with the perldoc command.
194              
195             perldoc Net::Connection::Sort
196              
197              
198             You can also look for information at:
199              
200             =over 4
201              
202             =item * RT: CPAN's request tracker (report bugs here)
203              
204             L
205              
206             =item * AnnoCPAN: Annotated CPAN documentation
207              
208             L
209              
210             =item * CPAN Ratings
211              
212             L
213              
214             =item * Search CPAN
215              
216             L
217              
218             =item * Git Repo
219              
220             L
221              
222             =back
223              
224              
225             =head1 ACKNOWLEDGEMENTS
226              
227              
228             =head1 LICENSE AND COPYRIGHT
229              
230             This software is Copyright (c) 2019 by Zane C. Bowers-Hadley.
231              
232             This is free software, licensed under:
233              
234             The Artistic License 2.0 (GPL Compatible)
235              
236              
237             =cut
238              
239             1; # End of Net::Connection::Sort