Filename | /usr/share/perl5/Net/LDAP/Message.pm |
Statements | Executed 27 statements in 2.14ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 7.02ms | 9.10ms | BEGIN@7 | Net::LDAP::Message::
1 | 1 | 1 | 790µs | 104ms | BEGIN@8 | Net::LDAP::Message::
1 | 1 | 1 | 20µs | 26µs | BEGIN@9 | Net::LDAP::Message::
1 | 1 | 1 | 16µs | 62µs | BEGIN@10 | Net::LDAP::Message::
1 | 1 | 1 | 13µs | 47µs | BEGIN@251 | Net::LDAP::Message::Dummy::
0 | 0 | 0 | 0s | 0s | is_error | Net::LDAP::Compare::
0 | 0 | 0 | 0s | 0s | abandon | Net::LDAP::Message::Dummy::
0 | 0 | 0 | 0s | 0s | code | Net::LDAP::Message::Dummy::
0 | 0 | 0 | 0s | 0s | decode | Net::LDAP::Message::Dummy::
0 | 0 | 0 | 0s | 0s | dn | Net::LDAP::Message::Dummy::
0 | 0 | 0 | 0s | 0s | done | Net::LDAP::Message::Dummy::
0 | 0 | 0 | 0s | 0s | error | Net::LDAP::Message::Dummy::
0 | 0 | 0 | 0s | 0s | sync | Net::LDAP::Message::Dummy::
0 | 0 | 0 | 0s | 0s | NewMesgID | Net::LDAP::Message::
0 | 0 | 0 | 0s | 0s | abandon | Net::LDAP::Message::
0 | 0 | 0 | 0s | 0s | callback | Net::LDAP::Message::
0 | 0 | 0 | 0s | 0s | code | Net::LDAP::Message::
0 | 0 | 0 | 0s | 0s | control | Net::LDAP::Message::
0 | 0 | 0 | 0s | 0s | decode | Net::LDAP::Message::
0 | 0 | 0 | 0s | 0s | dn | Net::LDAP::Message::
0 | 0 | 0 | 0s | 0s | done | Net::LDAP::Message::
0 | 0 | 0 | 0s | 0s | encode | Net::LDAP::Message::
0 | 0 | 0 | 0s | 0s | error | Net::LDAP::Message::
0 | 0 | 0 | 0s | 0s | error_desc | Net::LDAP::Message::
0 | 0 | 0 | 0s | 0s | error_name | Net::LDAP::Message::
0 | 0 | 0 | 0s | 0s | error_text | Net::LDAP::Message::
0 | 0 | 0 | 0s | 0s | is_error | Net::LDAP::Message::
0 | 0 | 0 | 0s | 0s | mesg_id | Net::LDAP::Message::
0 | 0 | 0 | 0s | 0s | new | Net::LDAP::Message::
0 | 0 | 0 | 0s | 0s | parent | Net::LDAP::Message::
0 | 0 | 0 | 0s | 0s | pdu | Net::LDAP::Message::
0 | 0 | 0 | 0s | 0s | referrals | Net::LDAP::Message::
0 | 0 | 0 | 0s | 0s | saslref | Net::LDAP::Message::
0 | 0 | 0 | 0s | 0s | server_error | Net::LDAP::Message::
0 | 0 | 0 | 0s | 0s | set_error | Net::LDAP::Message::
0 | 0 | 0 | 0s | 0s | sync | Net::LDAP::Message::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # Copyright (c) 1997-2004 Graham Barr <gbarr@pobox.com>. All rights reserved. | ||||
2 | # This program is free software; you can redistribute it and/or | ||||
3 | # modify it under the same terms as Perl itself. | ||||
4 | |||||
5 | package Net::LDAP::Message; | ||||
6 | |||||
7 | 3 | 249µs | 2 | 9.61ms | # spent 9.10ms (7.02+2.08) within Net::LDAP::Message::BEGIN@7 which was called:
# once (7.02ms+2.08ms) by Net::LDAP::BEGIN@13 at line 7 # spent 9.10ms making 1 call to Net::LDAP::Message::BEGIN@7
# spent 507µs making 1 call to Exporter::import |
8 | 3 | 235µs | 2 | 104ms | # spent 104ms (790µs+103) within Net::LDAP::Message::BEGIN@8 which was called:
# once (790µs+103ms) by Net::LDAP::BEGIN@13 at line 8 # spent 104ms making 1 call to Net::LDAP::Message::BEGIN@8
# spent 35µs making 1 call to Net::LDAP::ASN::import |
9 | 3 | 36µs | 2 | 32µs | # spent 26µs (20+6) within Net::LDAP::Message::BEGIN@9 which was called:
# once (20µs+6µs) by Net::LDAP::BEGIN@13 at line 9 # spent 26µs making 1 call to Net::LDAP::Message::BEGIN@9
# spent 6µs making 1 call to strict::import |
10 | 3 | 1.42ms | 2 | 107µs | # spent 62µs (16+45) within Net::LDAP::Message::BEGIN@10 which was called:
# once (16µs+45µs) by Net::LDAP::BEGIN@13 at line 10 # spent 62µs making 1 call to Net::LDAP::Message::BEGIN@10
# spent 45µs making 1 call to vars::import |
11 | |||||
12 | 1 | 900ns | $VERSION = "1.11"; | ||
13 | |||||
14 | 1 | 500ns | my $MsgID = 0; | ||
15 | |||||
16 | # We do this here so when we add threading we can lock it | ||||
17 | sub NewMesgID { | ||||
18 | $MsgID = 1 if ++$MsgID > 65535; | ||||
19 | $MsgID; | ||||
20 | } | ||||
21 | |||||
22 | sub new { | ||||
23 | my $self = shift; | ||||
24 | my $type = ref($self) || $self; | ||||
25 | my $parent = shift->inner; | ||||
26 | my $arg = shift; | ||||
27 | |||||
28 | $self = bless { | ||||
29 | parent => $parent, | ||||
30 | mesgid => NewMesgID(), | ||||
31 | callback => $arg->{callback} || undef, | ||||
32 | raw => $arg->{raw} || undef, | ||||
33 | }, $type; | ||||
34 | |||||
35 | $self; | ||||
36 | } | ||||
37 | |||||
38 | sub code { | ||||
39 | my $self = shift; | ||||
40 | |||||
41 | $self->sync unless exists $self->{resultCode}; | ||||
42 | |||||
43 | exists $self->{resultCode} | ||||
44 | ? $self->{resultCode} | ||||
45 | : undef | ||||
46 | } | ||||
47 | |||||
48 | sub done { | ||||
49 | my $self = shift; | ||||
50 | |||||
51 | exists $self->{resultCode}; | ||||
52 | } | ||||
53 | |||||
54 | sub dn { | ||||
55 | my $self = shift; | ||||
56 | |||||
57 | $self->sync unless exists $self->{resultCode}; | ||||
58 | |||||
59 | exists $self->{matchedDN} | ||||
60 | ? $self->{matchedDN} | ||||
61 | : undef | ||||
62 | } | ||||
63 | |||||
64 | sub referrals { | ||||
65 | my $self = shift; | ||||
66 | |||||
67 | $self->sync unless exists $self->{resultCode}; | ||||
68 | |||||
69 | exists $self->{referral} | ||||
70 | ? @{$self->{referral}} | ||||
71 | : (); | ||||
72 | } | ||||
73 | |||||
74 | sub server_error { | ||||
75 | my $self = shift; | ||||
76 | |||||
77 | $self->sync unless exists $self->{resultCode}; | ||||
78 | |||||
79 | exists $self->{errorMessage} | ||||
80 | ? $self->{errorMessage} | ||||
81 | : undef | ||||
82 | } | ||||
83 | |||||
84 | sub error { | ||||
85 | my $self = shift; | ||||
86 | my $return; | ||||
87 | |||||
88 | unless ($return = $self->server_error) { | ||||
89 | require Net::LDAP::Util and | ||||
90 | $return = Net::LDAP::Util::ldap_error_desc( $self->code ); | ||||
91 | } | ||||
92 | |||||
93 | $return; | ||||
94 | } | ||||
95 | |||||
96 | sub set_error { | ||||
97 | my $self = shift; | ||||
98 | ($self->{resultCode},$self->{errorMessage}) = ($_[0]+0, "$_[1]"); | ||||
99 | $self->{callback}->($self) | ||||
100 | if (defined $self->{callback}); | ||||
101 | $self; | ||||
102 | } | ||||
103 | |||||
104 | sub error_name { | ||||
105 | require Net::LDAP::Util; | ||||
106 | Net::LDAP::Util::ldap_error_name(shift->code); | ||||
107 | } | ||||
108 | |||||
109 | sub error_text { | ||||
110 | require Net::LDAP::Util; | ||||
111 | Net::LDAP::Util::ldap_error_text(shift->code); | ||||
112 | } | ||||
113 | |||||
114 | sub error_desc { | ||||
115 | require Net::LDAP::Util; | ||||
116 | Net::LDAP::Util::ldap_error_desc(shift->code); | ||||
117 | } | ||||
118 | |||||
119 | sub sync { | ||||
120 | my $self = shift; | ||||
121 | my $ldap = $self->{parent}; | ||||
122 | my $err; | ||||
123 | |||||
124 | until(exists $self->{resultCode}) { | ||||
125 | $err = $ldap->sync($self->mesg_id) or next; | ||||
126 | $self->set_error($err,"Protocol Error") | ||||
127 | unless exists $self->{resultCode}; | ||||
128 | return $err; | ||||
129 | } | ||||
130 | |||||
131 | LDAP_SUCCESS; | ||||
132 | } | ||||
133 | |||||
134 | |||||
135 | sub decode { # $self, $pdu, $control | ||||
136 | my $self = shift; | ||||
137 | my $result = shift; | ||||
138 | my $data = (values %{$result->{protocolOp}})[0]; | ||||
139 | |||||
140 | @{$self}{keys %$data} = values %$data; | ||||
141 | |||||
142 | @{$self}{qw(controls ctrl_hash)} = ($result->{controls}, undef); | ||||
143 | |||||
144 | # free up memory as we have a result so we will not need to re-send it | ||||
145 | delete $self->{pdu}; | ||||
146 | |||||
147 | if ($data = delete $result->{protocolOp}{intermediateResponse}) { | ||||
148 | |||||
149 | my $intermediate = Net::LDAP::Intermediate->from_asn($data); | ||||
150 | |||||
151 | push(@{$self->{'intermediate'} ||= []}, $intermediate); | ||||
152 | |||||
153 | $self->{callback}->($self, $intermediate) | ||||
154 | if (defined $self->{callback}); | ||||
155 | |||||
156 | return $self; | ||||
157 | } else { | ||||
158 | # tell our LDAP client to forget us as this message has now completed | ||||
159 | # all communications with the server | ||||
160 | $self->parent->_forgetmesg($self); | ||||
161 | } | ||||
162 | |||||
163 | $self->{callback}->($self) | ||||
164 | if (defined $self->{callback}); | ||||
165 | |||||
166 | $self; | ||||
167 | } | ||||
168 | |||||
169 | |||||
170 | sub abandon { | ||||
171 | my $self = shift; | ||||
172 | |||||
173 | return if exists $self->{resultCode}; # already complete | ||||
174 | |||||
175 | my $ldap = $self->{parent}; | ||||
176 | |||||
177 | $ldap->abandon($self->{mesgid}); | ||||
178 | } | ||||
179 | |||||
180 | sub saslref { | ||||
181 | my $self = shift; | ||||
182 | |||||
183 | $self->sync unless exists $self->{resultCode}; | ||||
184 | |||||
185 | exists $self->{sasl} | ||||
186 | ? $self->{sasl} | ||||
187 | : undef | ||||
188 | } | ||||
189 | |||||
190 | |||||
191 | sub encode { | ||||
192 | my $self = shift; | ||||
193 | |||||
194 | $self->{pdu} = $LDAPRequest->encode(@_, messageID => $self->{mesgid}) | ||||
195 | or return; | ||||
196 | 1; | ||||
197 | } | ||||
198 | |||||
199 | sub control { | ||||
200 | my $self = shift; | ||||
201 | |||||
202 | if ($self->{controls}) { | ||||
203 | require Net::LDAP::Control; | ||||
204 | my $hash = $self->{ctrl_hash} = {}; | ||||
205 | foreach my $asn (@{delete $self->{controls}}) { | ||||
206 | my $ctrl = Net::LDAP::Control->from_asn($asn); | ||||
207 | $ctrl->{raw} = $self->{parent}->{raw} | ||||
208 | if ($self->{parent}); | ||||
209 | push @{$hash->{$ctrl->type} ||= []}, $ctrl; | ||||
210 | } | ||||
211 | } | ||||
212 | |||||
213 | my $ctrl_hash = $self->{ctrl_hash} | ||||
214 | or return; | ||||
215 | |||||
216 | my @oid = @_ ? @_ : keys %$ctrl_hash; | ||||
217 | my @control = map {@$_} grep $_, @{$ctrl_hash}{@oid} | ||||
218 | or return; | ||||
219 | |||||
220 | # return a list, so in a scalar context we do not just get array length | ||||
221 | return @control[0 .. $#control]; | ||||
222 | } | ||||
223 | |||||
224 | sub pdu { shift->{pdu} } | ||||
225 | sub callback { shift->{callback} } | ||||
226 | sub parent { shift->{parent}->outer } | ||||
227 | sub mesg_id { shift->{mesgid} } | ||||
228 | sub is_error { shift->code } | ||||
229 | |||||
230 | ## | ||||
231 | ## | ||||
232 | ## | ||||
233 | |||||
234 | |||||
235 | 1 | 11µs | @Net::LDAP::Add::ISA = qw(Net::LDAP::Message); | ||
236 | 1 | 5µs | @Net::LDAP::Delete::ISA = qw(Net::LDAP::Message); | ||
237 | 1 | 10µs | @Net::LDAP::Modify::ISA = qw(Net::LDAP::Message); | ||
238 | 1 | 4µs | @Net::LDAP::ModDN::ISA = qw(Net::LDAP::Message); | ||
239 | 1 | 4µs | @Net::LDAP::Compare::ISA = qw(Net::LDAP::Message); | ||
240 | 1 | 5µs | @Net::LDAP::Unbind::ISA = qw(Net::LDAP::Message::Dummy); | ||
241 | 1 | 4µs | @Net::LDAP::Abandon::ISA = qw(Net::LDAP::Message::Dummy); | ||
242 | |||||
243 | sub Net::LDAP::Compare::is_error { | ||||
244 | my $mesg = shift; | ||||
245 | my $code = $mesg->code; | ||||
246 | $code != LDAP_COMPARE_FALSE and $code != LDAP_COMPARE_TRUE | ||||
247 | } | ||||
248 | |||||
249 | { | ||||
250 | 1 | 900ns | package Net::LDAP::Message::Dummy; | ||
251 | 3 | 145µs | 2 | 81µs | # spent 47µs (13+34) within Net::LDAP::Message::Dummy::BEGIN@251 which was called:
# once (13µs+34µs) by Net::LDAP::BEGIN@13 at line 251 # spent 47µs making 1 call to Net::LDAP::Message::Dummy::BEGIN@251
# spent 34µs making 1 call to vars::import |
252 | 1 | 8µs | @ISA = qw(Net::LDAP::Message); | ||
253 | |||||
254 | sub sync { shift } | ||||
255 | sub decode { shift } | ||||
256 | sub abandon { shift } | ||||
257 | sub code { 0 } | ||||
258 | sub error { "" } | ||||
259 | sub dn { "" } | ||||
260 | sub done { 1 } | ||||
261 | } | ||||
262 | |||||
263 | 1 | 9µs | 1; |