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