| Filename | /usr/share/perl5/Net/LDAP/Message.pm |
| Statements | Executed 27 statements in 2.01ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 5.41ms | 6.89ms | Net::LDAP::Message::BEGIN@7 |
| 1 | 1 | 1 | 780µs | 72.0ms | Net::LDAP::Message::BEGIN@8 |
| 1 | 1 | 1 | 18µs | 24µs | Net::LDAP::Message::BEGIN@9 |
| 1 | 1 | 1 | 17µs | 56µs | Net::LDAP::Message::BEGIN@10 |
| 1 | 1 | 1 | 12µs | 47µs | Net::LDAP::Message::Dummy::BEGIN@251 |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Compare::is_error |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::Dummy::abandon |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::Dummy::code |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::Dummy::decode |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::Dummy::dn |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::Dummy::done |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::Dummy::error |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::Dummy::sync |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::NewMesgID |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::abandon |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::callback |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::code |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::control |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::decode |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::dn |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::done |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::encode |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::error |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::error_desc |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::error_name |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::error_text |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::is_error |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::mesg_id |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::new |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::parent |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::pdu |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::referrals |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::saslref |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::server_error |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::set_error |
| 0 | 0 | 0 | 0s | 0s | Net::LDAP::Message::sync |
| 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 | 158µs | 2 | 7.24ms | # spent 6.89ms (5.41+1.48) within Net::LDAP::Message::BEGIN@7 which was called:
# once (5.41ms+1.48ms) by Net::LDAP::BEGIN@13 at line 7 # spent 6.89ms making 1 call to Net::LDAP::Message::BEGIN@7
# spent 353µs making 1 call to Exporter::import |
| 8 | 3 | 197µs | 2 | 72.0ms | # spent 72.0ms (780µs+71.2) within Net::LDAP::Message::BEGIN@8 which was called:
# once (780µs+71.2ms) by Net::LDAP::BEGIN@13 at line 8 # spent 72.0ms making 1 call to Net::LDAP::Message::BEGIN@8
# spent 38µs making 1 call to Net::LDAP::ASN::import |
| 9 | 3 | 40µs | 2 | 30µs | # spent 24µs (18+6) within Net::LDAP::Message::BEGIN@9 which was called:
# once (18µs+6µs) by Net::LDAP::BEGIN@13 at line 9 # spent 24µs making 1 call to Net::LDAP::Message::BEGIN@9
# spent 6µs making 1 call to strict::import |
| 10 | 3 | 1.33ms | 2 | 95µs | # spent 56µs (17+39) within Net::LDAP::Message::BEGIN@10 which was called:
# once (17µs+39µs) by Net::LDAP::BEGIN@13 at line 10 # spent 56µs making 1 call to Net::LDAP::Message::BEGIN@10
# spent 39µs making 1 call to vars::import |
| 11 | |||||
| 12 | 1 | 1µs | $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 | 12µs | @Net::LDAP::Add::ISA = qw(Net::LDAP::Message); | ||
| 236 | 1 | 5µs | @Net::LDAP::Delete::ISA = qw(Net::LDAP::Message); | ||
| 237 | 1 | 5µ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 | 1µs | package Net::LDAP::Message::Dummy; | ||
| 251 | 3 | 227µs | 2 | 82µs | # spent 47µs (12+35) within Net::LDAP::Message::Dummy::BEGIN@251 which was called:
# once (12µs+35µs) by Net::LDAP::BEGIN@13 at line 251 # spent 47µs making 1 call to Net::LDAP::Message::Dummy::BEGIN@251
# spent 35µs making 1 call to vars::import |
| 252 | 1 | 7µ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 | 8µs | 1; |