File Coverage

t/inc/TestFilterHelpers.pm
Criterion Covered Total %
statement 67 96 69.8
branch 37 90 41.1
condition 5 17 29.4
subroutine 12 13 92.3
total 121 216 56.0


line stmt bran cond sub code
1         package TestFilterHelpers;
2 1     1 use strict; use warnings FATAL => 'all';
  1     1  
  1        
  1        
  1        
  1        
3          
4         require Carp;
5         require Scalar::Util;
6          
7         =pod
8        
9         =head1 NAME
10        
11         TestFilterHelpers - POE::Filter::IRC(d,v3) test helpers
12        
13         =head1 SYNOPSIS
14        
15         use Test::More;
16         use lib 't/inc';
17         use TestFilterHelpers;
18        
19         my $line = ':test foo';
20         get_ok $filter, $line =>
21         +{
22         raw_line => $line,
23         command => 'FOO',
24         prefix => 'test',
25         },
26         'my get test ok' ;
27        
28         put_ok $filter, $line =>
29         +{ command => 'foo', prefix => 'test' },
30         'my put test ok' ;
31        
32         get_command_ok $filter, $line => $cmd, $name;
33        
34         get_prefix_ok $filter, $line => $prefix, $name;
35        
36         get_params_ok $filter, $line => [@params], $name;
37        
38         get_rawline_ok $filter, $line, $name;
39        
40         get_tags_ok $filter, $line => +{%tags}, $name;
41        
42         done_testing;
43        
44         =head1 DESCRIPTION
45        
46         A simple set of L<Test::Deep> and L<Test::Builder> based helpers for testing
47         L<POE::Filter::IRCv3> (and L<POE::Filter::IRCD>).
48        
49         =head1 AUTHOR
50        
51         Jon Portnoy <avenj@cobaltirc.org>
52        
53         =cut
54          
55          
56 1       use Test::Deep::NoTest qw/
57         cmp_deeply
58        
59         cmp_details
60         deep_diag
61 1     1 /;
  1        
62          
63 1     1 use base 'Exporter';
  1        
  1        
64         our @EXPORT = qw/
65         get_ok
66         put_ok
67        
68         get_command_ok
69         get_prefix_ok
70         get_params_ok
71         get_rawline_ok
72         get_tags_ok
73         /;
74          
75         my $Test = Test::Builder->new;
76         sub import {
77 1     1   my $self = shift;
78 1 50       if (@_) {
79 0           my $pkg = caller;
80 0           $Test->exported_to( $pkg );
81 0           $Test->plan( @_ );
82           }
83 1         $self->export_to_level( 1, $self, $_ ) for @EXPORT;
84         }
85          
86          
87         sub _looks_ok {
88 37     37   my ($got, $expected, $name) = @_;
89          
90 37         local $Test::Builder::Level = $Test::Builder::Level + 1;
91          
92 37         my ($ok, $stack) = cmp_details($got, $expected);
93          
94 37 0 50     unless ( $Test->ok($ok, $name) && return 1 ) {
95 0 0 0       if (ref $got && ref $expected) {
96 0             $Test->diag( "Structures:\n",
97                 "Expected ->\n",
98                 $Test->explain($expected),
99                 "Got ->\n",
100                 $Test->explain($got),
101               )
102             }
103          
104 0           $Test->diag( deep_diag($stack) )
105           }
106          
107           return
108 0       }
109          
110          
111         sub put_ok {
112 12     12   my ($filter, $line, $ref, $name) = @_;
113          
114 12 50       unless (Scalar::Util::blessed $filter) {
115 0           Carp::croak "put_ok expected blessed filter obj"
116           }
117          
118 12 50 33     unless (defined $line && !ref($line) && ref $ref eq 'HASH') {
      33    
119 0           Carp::croak "put_ok expected a line to compare and a HASH to process"
120           }
121          
122 12         my $arr = $filter->put([ $ref ]);
123 12 50       Carp::croak "filter did not return ARRAY for $ref"
124             unless ref $arr eq 'ARRAY';
125 12 50       Carp::croak "filter did not return line for $ref"
126             unless defined $arr->[0];
127          
128 12 50       $name = 'line looks ok' unless defined $name;
129          
130 12 50       _looks_ok( $arr, [ $line ], $name ) ?
131             $arr->[0] : ()
132         }
133          
134          
135         sub get_ok {
136 15     15   my ($filter, $line, $ref, $name) = @_;
137          
138 15 50       unless (Scalar::Util::blessed $filter) {
139 0           Carp::croak "get_ok expected blessed filter obj"
140           }
141          
142 15 50 33     unless (defined $line && ref $ref eq 'HASH') {
143 0           Carp::croak "get_ok expected a line to process and HASH to compare"
144           }
145          
146 15 50       $ref->{raw_line} = $line unless exists $ref->{raw_line};
147          
148 15         my $arr = $filter->get([ $line ]);
149          
150 15 50       Carp::croak "filter did not return ARRAY for $line"
151             unless ref $arr eq 'ARRAY';
152          
153 15 50       $name = 'struct looks ok' unless defined $name;
154 15 50       _looks_ok( $arr, [$ref], $name ) ?
155             $arr->[0] : ()
156         }
157          
158          
159         sub get_command_ok {
160 3     3   my ($filter, $line, $cmd, $name) = @_;
161          
162 3 50       unless (Scalar::Util::blessed $filter) {
163 0           Carp::croak "get_command_ok expected blessed filter obj"
164           }
165          
166 3 50 33     unless (defined $line && defined $cmd) {
167 0           Carp::croak "get_command_ok expected a line to process and command to compare"
168           }
169          
170 3         my $arr = $filter->get([ $line ]);
171          
172 3 50       Carp::croak "filter did not return ARRAY for $line"
173             unless ref $arr eq 'ARRAY';
174 3 50       Carp::croak "filter did not return event for $line"
175             unless ref $arr->[0] eq 'HASH';
176          
177 3 50       $name = 'command looks ok' unless defined $name;
178 3 50       _looks_ok( $arr->[0]->{command}, $cmd, $name ) ?
179             $cmd : ()
180         }
181          
182         sub get_prefix_ok {
183 3     3   my ($filter, $line, $pfx, $name) = @_;
184          
185 3 50       unless (Scalar::Util::blessed $filter) {
186 0           Carp::croak "get_prefix_ok expected blessed filter obj"
187           }
188          
189         # undef prefix is a valid comparison:
190 3 50       unless (defined $line) {
191 0           Carp::croak "get_prefix_ok expected a line to process and prefix to compare"
192           }
193          
194 3         my $arr = $filter->get([ $line ]);
195 3 50       Carp::croak "filter did not return ARRAY for $line"
196             unless ref $arr eq 'ARRAY';
197 3 50       Carp::croak "filter did not return event for $line"
198             unless ref $arr->[0] eq 'HASH';
199          
200 3 50       $name = 'prefix looks ok' unless defined $name;
201 3 50       _looks_ok( $arr->[0]->{prefix}, $pfx, $name ) ?
202             $pfx : ()
203         }
204          
205         sub get_params_ok {
206 2     2   my ($filter, $line, $pref, $name) = @_;
207          
208 2 50       unless (Scalar::Util::blessed $filter) {
209 0           Carp::croak "get_params_ok expected blessed filter obj"
210           }
211          
212         # pref => undef is legit
213 2 50       unless (defined $line) {
214 0           Carp::croak "get_params_ok expected a line to process and params to compare"
215           }
216          
217 2         my $arr = $filter->get([ $line ]);
218 2 50       Carp::croak "filter did not return ARRAY for $line"
219             unless ref $arr eq 'ARRAY';
220 2 50       Carp::croak "filter did not return event for $line"
221             unless ref $arr->[0] eq 'HASH';
222          
223 2 50       $name = 'params look ok' unless defined $name;
224 2 50       _looks_ok( $arr->[0]->{params}, $pref, $name ) ?
225             $arr->[0]->{params} : ()
226         }
227          
228         sub get_rawline_ok {
229 0     0   my ($filter, $line, $name) = @_;
230           
231 0 0       unless (Scalar::Util::blessed $filter) {
232 0           Carp::croak "get_rawline_ok expected blessed filter obj"
233           }
234          
235 0 0       unless (defined $line) {
236 0           Carp::croak "get_rawline_ok expected a line to process"
237           }
238          
239 0         my $arr = $filter->get([ $line ]);
240 0 0       Carp::croak "filter did not return ARRAY for $line"
241             unless ref $arr eq 'ARRAY';
242 0 0       Carp::croak "filter did not return event for $line"
243             unless ref $arr->[0] eq 'HASH';
244          
245 0 0       $name = 'raw_line looks ok' unless defined $name;
246 0 0       _looks_ok( $arr->[0]->{raw_line}, $line, $name ) ?
247             $line : ()
248         }
249          
250         sub get_tags_ok {
251 2     2   my ($filter, $line, $tags, $name) = @_;
252          
253 2 50       unless (Scalar::Util::blessed $filter) {
254 0           Carp::croak "get_tags_ok expected blessed filter obj"
255           }
256          
257 2 50       unless (defined $line) {
258 0           Carp::croak "get_tags_ok expected a line to process and a tags HASH to compare"
259           }
260          
261 2         my $arr = $filter->get([ $line ]);
262 2 50       Carp::croak "filter did not return ARRAY for $line"
263             unless ref $arr eq 'ARRAY';
264 2 50       Carp::croak "filter did not return event for $line"
265             unless ref $arr->[0] eq 'HASH';
266          
267 2 50       $name = 'tags look ok' unless defined $name;
268 2 50       _looks_ok( $arr->[0]->{tags}, $tags, $name ) ?
269             $arr->[0]->{tags} : ()
270         }
271          
272          
273         1;
274