File Coverage

blib/lib/Test/Net/LDAP/Util.pm
Criterion Covered Total %
statement 57 63 90.4
branch 10 18 55.5
condition 4 9 44.4
subroutine 13 13 100.0
pod 4 4 100.0
total 88 107 82.2


line stmt bran cond sub pod time code
1 14     14   129112 use 5.006;
  14         30  
  14         404  
2 14     14   51 use strict;
  14         15  
  14         338  
3 14     14   40 use warnings;
  14         21  
  14         429  
4              
5             package Test::Net::LDAP::Util;
6 14     14   127 use base 'Exporter';
  14         19  
  14         904  
7 14     14   56 use Net::LDAP;
  14         14  
  14         71  
8 14     14   503 use Net::LDAP::Constant qw(LDAP_SUCCESS);
  14         20  
  14         506  
9 14     14   29488 use Net::LDAP::Util qw(ldap_error_name ldap_error_text canonical_dn);
  14         710  
  14         890  
10 14     14   63 use Test::Builder;
  14         14  
  14         5745  
11              
12             our @EXPORT_OK = qw(
13             ldap_result_ok
14             ldap_result_is
15             ldap_mockify
16             ldap_dn_is
17             );
18              
19             our %EXPORT_TAGS = (all => \@EXPORT_OK);
20              
21             =head1 NAME
22              
23             Test::Net::LDAP::Util - Testing utilities for Test::Net::LDAP
24              
25             =cut
26              
27             =head1 EXPORT
28              
29             The following subroutines are exported on demand.
30              
31             use Test::Net::LDAP::Util qw(
32             ldap_result_ok
33             ldap_result_is
34             ldap_mockify
35             ldap_dn_is
36             );
37              
38             All the subroutines are exported if C<:all> is specified.
39              
40             use Test::Net::LDAP::Util ':all';
41              
42             =cut
43              
44             =head1 SUBROUTINES
45              
46             =cut
47              
48             sub _format_diag {
49 2     2   3 my ($actual_text, $expected_text) = @_;
50              
51             # Indent spaces are based on Test::Builder::_is_diag implementation
52             # ($Test::Builder::VERSION == 0.98)
53 2         16 return sprintf("%12s: %s\n", 'got', $actual_text).
54             sprintf("%12s: %s\n", 'expected', $expected_text);
55             }
56              
57             =head2 ldap_result_ok
58              
59             ldap_result_ok($mesg, $name);
60              
61             Tests the result of an LDAP operation to see if the code is C.
62              
63             C<$mesg> is either a Net::LDAP::Message object returned by LDAP operation
64             methods or a result code.
65              
66             C<$name> is the optional test name.
67              
68             =cut
69              
70             sub ldap_result_ok {
71 2     2 1 47 my ($mesg, $name) = @_;
72 2         5 local $Test::Builder::Level = $Test::Builder::Level + 1;
73 2         4 return ldap_result_is($mesg, LDAP_SUCCESS, $name);
74             }
75              
76             =head2 ldap_result_is
77              
78             ldap_result_is($mesg, $expect, $name);
79              
80             Tests the result of an LDAP operation to see if the code is equal to C<$expect>.
81              
82             The values of C<$mesg> and C<$expect> are either a Net::LDAP::Message object
83             returned by LDAP operation methods or a result code.
84              
85             C<$name> is the optional test name.
86              
87             =cut
88              
89             my $test_builder;
90              
91             sub ldap_result_is {
92 159     159 1 208 my ($actual, $expected, $name) = @_;
93 159 50       266 $expected = LDAP_SUCCESS unless defined $expected;
94            
95 159   66     361 $test_builder ||= Test::Builder->new;
96            
97 159 100       655 my $actual_code = ref $actual ? $actual->code : $actual;
98 159 50       878 my $expected_code = ref $expected ? $expected->code : $expected;
99 159         242 my $success = ($actual_code == $expected_code);
100            
101 159         154 local $Test::Builder::Level = $Test::Builder::Level + 1;
102 159         363 $test_builder->ok($success, $name);
103            
104 159 100       43391 unless ($success) {
105 2   33     7 my $actual_text = ldap_error_name($actual).' ('.$actual_code.'): '.
106             ((ref $actual && $actual->error) || ldap_error_text($actual));
107            
108 2         73 my $expected_text = ldap_error_name($expected).' ('.$expected_code.')';
109              
110 2         12 $test_builder->diag(_format_diag($actual_text, $expected_text));
111             }
112            
113 159         490 return $actual;
114             }
115              
116             =head2 ldap_mockify
117              
118             ldap_mockify {
119             # CODE
120             };
121              
122             Inside the code block (recursively), all the occurrences of C
123             are replaced by C.
124              
125             Subclasses of C are also mockified. C is inserted
126             into C<@ISA> of each subclass, only within the context of C.
127              
128             See L for more details.
129              
130             =cut
131              
132             sub ldap_mockify(&) {
133 4     4 1 334 my ($callback) = @_;
134 4         565 require Test::Net::LDAP::Mock;
135 4         20 Test::Net::LDAP::Mock->mockify($callback);
136             }
137              
138             =head2 ldap_dn_is
139              
140             ldap_dn_is($actual_dn, $expect_dn, $name);
141              
142             Tests equality of two DNs that are not necessarily canonicalized.
143              
144             The comparison is case-insensitive.
145              
146             =cut
147              
148             sub ldap_dn_is {
149 54     54 1 18881 my ($actual_dn, $expected_dn, $name) = @_;
150 54         74 my ($actual_canonical_dn, $expected_canonical_dn) = ($actual_dn, $expected_dn);
151              
152 54         73 for my $dn ($actual_canonical_dn, $expected_canonical_dn) {
153 108 50       6428 $dn = lc canonical_dn($dn, casefold => 'none') if defined $dn;
154             }
155              
156 54         5333 my $success;
157              
158 54 50       125 if (defined $actual_dn) {
159 54 50       92 if (defined $expected_dn) {
160 54         74 $success = $actual_canonical_dn eq $expected_canonical_dn;
161             } else {
162 0         0 $success = 0;
163             }
164             } else {
165 0         0 $success = !defined $expected_dn;
166             }
167              
168 54         73 local $Test::Builder::Level = $Test::Builder::Level + 1;
169 54   33     98 $test_builder ||= Test::Builder->new;
170 54         139 $test_builder->ok($success, $name);
171              
172 54 50       13191 unless ($success) {
173 0           my ($actual_text, $expected_text) = ($actual_dn, $expected_dn);
174              
175 0           for my $text ($actual_text, $expected_text) {
176 0 0         $text = defined $text ? "'$text'" : 'undef';
177             }
178              
179 0           $test_builder->diag(_format_diag($actual_text, $expected_text));
180             }
181             }
182              
183             1;