File Coverage

blib/lib/Net/Connection/Match/Protos.pm
Criterion Covered Total %
statement 35 37 94.5
branch 12 14 85.7
condition n/a
subroutine 5 5 100.0
pod 2 2 100.0
total 54 58 93.1


line stmt bran cond sub pod time code
1             package Net::Connection::Match::Protos;
2              
3 3     3   223940 use 5.006;
  3         58  
4 3     3   17 use strict;
  3         6  
  3         81  
5 3     3   16 use warnings;
  3         6  
  3         1035  
6              
7             =head1 NAME
8              
9             Net::Connection::Match::Protos - Runs a protocol check against a Net::Connection object.
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::Match::Protos;
23             use Net::Connection;
24            
25             my $connection_args={
26             foreign_host=>'10.0.0.1',
27             foreign_port=>'22',
28             local_host=>'10.0.0.2',
29             local_port=>'12322',
30             proto=>'tcp4',
31             state=>'ESTABLISHED',
32             };
33            
34             my $conn=Net::Connection->new( $connection_args );
35            
36             my %args=(
37             protos=>[
38             'tcp4',
39             'tcp6',
40             ],
41             );
42            
43             my $checker=Net::Connection::Match::Protos->new( \%args );
44            
45             if ( $checker->match( $conn ) ){
46             print "It matches.\n";
47             }
48              
49             =head1 METHODS
50              
51             =head2 new
52              
53             This intiates the object.
54              
55             It takes a hash reference with one key. One key is required and
56             that is 'protos', which is a array of protocols to match against.
57              
58             Atleast one protocol must be present.
59              
60             If the new method fails, it dies.
61              
62             my %args=(
63             protos=>[
64             'tcp4',
65             ],
66             );
67            
68             my $checker=Net::Connection::Match::Protos->new( \%args );
69              
70             =cut
71              
72             sub new{
73 3     3 1 590 my %args;
74 3 100       11 if(defined($_[1])){
75 2         5 %args= %{$_[1]};
  2         9  
76             };
77              
78             # run some basic checks to make sure we have the minimum stuff required to work
79 3 100       10 if ( ! defined( $args{protos} ) ){
80 1         9 die ('No protos key specified in the argument hash');
81             }
82 2 50       10 if ( ref( \$args{protos} ) eq 'ARRAY' ){
83 0         0 die ('The protos key is not a array');
84             }
85 2 50       6 if ( ! defined $args{protos}[0] ){
86 0         0 die ('No states defined in the protos array');
87             }
88              
89 2         7 my $self = {
90             protos=>[],
91             };
92 2         4 bless $self;
93              
94             # lc everything for easier matching later
95 2         4 my $protos_int=0;
96 2         8 while( defined( $args{protos}[$protos_int] ) ){
97 2         11 $self->{protos}[$protos_int]=lc( $args{protos}[$protos_int] );
98              
99 2         6 $protos_int++;
100             }
101              
102 2         11 return $self;
103             }
104              
105             =head2 match
106              
107             Checks if a single Net::Connection object matches the stack.
108              
109             One argument is taken and that is a Net::Connection object.
110              
111             The returned value is a boolean.
112              
113             if ( $checker->match( $conn ) ){
114             print "The connection matches.\n";
115             }
116              
117             =cut
118              
119             sub match{
120 5     5 1 2070 my $self=$_[0];
121 5         11 my $object=$_[1];
122              
123 5 100       16 if ( !defined( $object ) ){
124 1         4 return 0;
125             }
126              
127 4 100       15 if ( ref( $object ) ne 'Net::Connection' ){
128 1         3 return 0;
129             }
130              
131 3         24 my $protos_int=0;
132 3         12 while( defined( $self->{protos}[$protos_int] ) ){
133 3 100       12 if ( $self->{protos}[$protos_int] eq lc( $object->proto ) ){
134 2         33 return 1;
135             }
136              
137 1         7 $protos_int++;
138             }
139              
140 1         15 return 0;
141             }
142              
143             =head1 AUTHOR
144              
145             Zane C. Bowers-Hadley, C<< >>
146              
147             =head1 BUGS
148              
149             Please report any bugs or feature requests to C, or through
150             the web interface at L. I will be notified, and then you'll
151             automatically be notified of progress on your bug as I make changes.
152              
153              
154              
155              
156             =head1 SUPPORT
157              
158             You can find documentation for this module with the perldoc command.
159              
160             perldoc Net::Connection::Match
161              
162              
163             You can also look for information at:
164              
165             =over 4
166              
167             =item * RT: CPAN's request tracker (report bugs here)
168              
169             L
170              
171             =item * AnnoCPAN: Annotated CPAN documentation
172              
173             L
174              
175             =item * CPAN Ratings
176              
177             L
178              
179             =item * Search CPAN
180              
181             L
182              
183             =back
184              
185              
186             =head1 ACKNOWLEDGEMENTS
187              
188              
189             =head1 LICENSE AND COPYRIGHT
190              
191             Copyright 2019 Zane C. Bowers-Hadley.
192              
193             This program is free software; you can redistribute it and/or modify it
194             under the terms of the the Artistic License (2.0). You may obtain a
195             copy of the full license at:
196              
197             L
198              
199             Any use, modification, and distribution of the Standard or Modified
200             Versions is governed by this Artistic License. By using, modifying or
201             distributing the Package, you accept this license. Do not use, modify,
202             or distribute the Package, if you do not accept this license.
203              
204             If your Modified Version has been derived from a Modified Version made
205             by someone other than you, you are nevertheless required to ensure that
206             your Modified Version complies with the requirements of this license.
207              
208             This license does not grant you the right to use any trademark, service
209             mark, tradename, or logo of the Copyright Holder.
210              
211             This license includes the non-exclusive, worldwide, free-of-charge
212             patent license to make, have made, use, offer to sell, sell, import and
213             otherwise transfer the Package with respect to any patent claims
214             licensable by the Copyright Holder that are necessarily infringed by the
215             Package. If you institute patent litigation (including a cross-claim or
216             counterclaim) against any party alleging that the Package constitutes
217             direct or contributory patent infringement, then this Artistic License
218             to you shall terminate on the date that such litigation is filed.
219              
220             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
221             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
222             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
223             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
224             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
225             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
226             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
227             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
228              
229              
230             =cut
231              
232             1; # End of Net::Connection::Match