File Coverage

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