File Coverage

blib/lib/Net/Connection/Sort.pm
Criterion Covered Total %
statement 8 29 27.5
branch 0 12 0.0
condition n/a
subroutine 3 5 60.0
pod 2 2 100.0
total 13 48 27.0


line stmt bran cond sub pod time code
1             package Net::Connection::Sort;
2              
3 1     1   66413 use 5.006;
  1         4  
4 1     1   5 use strict;
  1         2  
  1         20  
5 1     1   5 use warnings;
  1         1  
  1         347  
6              
7             =head1 NAME
8              
9             Net::Connection::Sort - Sorts array of Net::Connection objects.
10              
11             =head1 VERSION
12              
13             Version 0.1.1
14              
15             =cut
16              
17             our $VERSION = '0.1.1';
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           return $self->{sorter}->sorter( \@objects );
172             }
173              
174             =head1 AUTHOR
175              
176             Zane C. Bowers-Hadley, C<< >>
177              
178             =head1 BUGS
179              
180             Please report any bugs or feature requests to C, or through
181             the web interface at L. I will be notified, and then you'll
182             automatically be notified of progress on your bug as I make changes.
183              
184              
185              
186              
187             =head1 SUPPORT
188              
189             You can find documentation for this module with the perldoc command.
190              
191             perldoc Net::Connection::Sort
192              
193              
194             You can also look for information at:
195              
196             =over 4
197              
198             =item * RT: CPAN's request tracker (report bugs here)
199              
200             L
201              
202             =item * Search CPAN
203              
204             L
205              
206             =item * Git Repo
207              
208             L
209              
210             =back
211              
212              
213             =head1 ACKNOWLEDGEMENTS
214              
215              
216             =head1 LICENSE AND COPYRIGHT
217              
218             This software is Copyright (c) 2019 by Zane C. Bowers-Hadley.
219              
220             This is free software, licensed under:
221              
222             The Artistic License 2.0 (GPL Compatible)
223              
224              
225             =cut
226              
227             1; # End of Net::Connection::Sort