Browse Source

add a testing arg to make testing less noisy with expected alert messages and begin work on the tests for the Match module

tags/0.0.0
Zane C. B-H 1 month ago
parent
commit
6fcfbb57d7
2 changed files with 126 additions and 10 deletions
  1. 53
    10
      Net-Connection-Match/lib/Net/Connection/Match.pm
  2. 73
    0
      Net-Connection-Match/t/Match.t

+ 53
- 10
Net-Connection-Match/lib/Net/Connection/Match.pm View File

@@ -27,6 +27,33 @@ our $VERSION = '0.0.0';
27 27
 
28 28
 =head2 new
29 29
 
30
+This initializes a new check object.
31
+
32
+It takes one value and thht is a hash ref with the key checks.
33
+This is a array of hashes.
34
+
35
+=head3 checks hash keys
36
+
37
+=head4 type
38
+
39
+This is the name of the check relative to 'Net::Connection::Match::'.
40
+
41
+So 'Net::Connection::Match::PTR' would become 'PTR'.
42
+
43
+=head4 args
44
+
45
+This is a hash or args to pash to the check. These are passed to the new
46
+method of the check module.
47
+
48
+=head4 invert
49
+
50
+This is either boolean on if the check should be inverted or not.
51
+
52
+    my $mce;
53
+    eval{
54
+        $ncm=Net::Connection::Match->new( $args );
55
+    };
56
+
30 57
 =cut
31 58
 
32 59
 sub new{
@@ -41,14 +68,14 @@ sub new{
41 68
 	if ( ! defined( $args{checks} )	){
42 69
 		die ('No check key specified in the argument hash');
43 70
 	}
44
-	if ( ref( $args{checks} ) eq 'ARRAY' ){
71
+	if ( ref( @{ $args{checks} } ) eq 'ARRAY' ){
45 72
 		die ('The checks key is not a array');
46 73
 	}
47 74
 	# Will never match anything.
48 75
 	if ( ! defined $args{checks}[0] ){
49 76
 		die ('Nothing in the checks array');
50 77
 	}
51
-	if ( ref( $args{checks}[0] ) eq 'HASH' ){
78
+	if ( ref( %{ $args{checks}[0] } ) eq 'HASH' ){
52 79
 		die ('The first item in the checks array is not a hash');
53 80
 	}
54 81
 
@@ -56,6 +83,7 @@ sub new{
56 83
 				perror=>undef,
57 84
 				error=>undef,
58 85
 				errorString=>"",
86
+				testing=>0,
59 87
 				errorExtra=>{
60 88
 							 flags=>{
61 89
 									 1=>'failedCheckInit',
@@ -122,11 +150,7 @@ sub new{
122 150
 		eval( $eval_string );
123 151
 
124 152
 		if (!defined( $check )){
125
-			$self->{error}=1;
126
-			$self->{errorString}='Failed to init the check for '.$check_int.' as it returned undef... '.$@;
127
-			$self->warn;
128
-			$self->{perror}=1;
129
-			return $self;
153
+			die 'Failed to init the check for '.$check_int.' as it returned undef... '.$@;
130 154
 		}
131 155
 
132 156
 		$new_check{check}=$check;
@@ -136,16 +160,20 @@ sub new{
136 160
 		$check_int++;
137 161
 	}
138 162
 
163
+	if ( $args{testing} ){
164
+		$self->{testing}=1;
165
+	}
166
+
139 167
 	return $self;
140 168
 }
141 169
 
142
-=head2 matches
170
+=head2 match
143 171
 
144 172
 Checks if a single Net::Connection object matches the stack.
145 173
 
146 174
 =cut
147 175
 
148
-sub matches{
176
+sub match{
149 177
 	my $self=$_[0];
150 178
 	my $conn=$_[1];
151 179
 
@@ -159,7 +187,9 @@ sub matches{
159 187
 		){
160 188
 		$self->{error}=2;
161 189
 		$self->{errorString}='Either the connection is undefined or is not a Net::Connection object';
162
-		$self->warn;
190
+		if ( ! $self->{testing} ){
191
+			$self->warn;
192
+		}
163 193
 		return undef;
164 194
 	}
165 195
 
@@ -198,6 +228,19 @@ sub matches{
198 228
 	return 0;
199 229
 }
200 230
 
231
+=head1 ERROR HANDLING / FLAGS
232
+
233
+Error handling is provided by L<Error::Helper>.
234
+
235
+=head2 1 / failedCheckInit
236
+
237
+Calling new for one or more of the checks failed.
238
+
239
+=head2 2 / notNCobj
240
+
241
+Not a Net::Connection object. Either is is not defined
242
+or what is being passed is not a Net::Connection object.
243
+
201 244
 =head1 AUTHOR
202 245
 
203 246
 Zane C. Bowers-Hadley, C<< <vvelox at vvelox.net> >>

+ 73
- 0
Net-Connection-Match/t/Match.t View File

@@ -0,0 +1,73 @@
1
+#!perl -T
2
+use 5.006;
3
+use strict;
4
+use warnings;
5
+use Test::More;
6
+use Net::Connection;
7
+
8
+BEGIN {
9
+    use_ok( 'Net::Connection::Match' ) || print "Bail out!\n";
10
+}
11
+
12
+my $connection_args={
13
+					  foreign_host=>'10.0.0.1',
14
+					  foreign_port=>'22',
15
+					  local_host=>'10.0.0.2',
16
+					  local_port=>'12322',
17
+					  proto=>'tcp4',
18
+					  state=>'LISTEN',
19
+					  };
20
+
21
+my %args=(
22
+		  testing=>1,
23
+		  checks=>[
24
+				   {
25
+					type=>'Ports',
26
+					invert=>0,
27
+					args=>{
28
+						   ports=>[
29
+								   '22',
30
+								   ],
31
+						   lports=>[
32
+									'53',
33
+									],
34
+						   fports=>[
35
+									'12345',
36
+									],
37
+						   }
38
+					}
39
+				   ]
40
+		  );
41
+my $checker;
42
+
43
+# makes sure we error with empty args
44
+my $worked=0;
45
+eval{
46
+	$checker=Net::Connection::Match->new();
47
+	$worked=1;
48
+};
49
+ok( $worked eq '0', 'empty init check') or diag('Calling new with empty args worked');
50
+
51
+# makes sure we can init with good args
52
+$worked=0;
53
+eval{
54
+	$checker=Net::Connection::Match->new( \%args );
55
+	$worked=1;
56
+};
57
+ok( $worked eq '1', 'init check') or diag('Calling Net::Connection::Match::Ports->new resulted in... '.$@);
58
+
59
+# make sure it will not accept a improper ref type
60
+my $returned;
61
+eval{
62
+	$returned=$checker->match($checker);
63
+};
64
+ok( $checker->error eq '2', 'match improper ref check') or diag('match accepted a ref other than Net::Connection');
65
+
66
+
67
+# make sure it will not accept null input
68
+eval{
69
+	$returned=$checker->match();
70
+};
71
+ok( $checker->error eq '2', 'match null input check') or diag('match accepted a ref other than Net::Connection');
72
+
73
+done_testing(5);

Loading…
Cancel
Save