← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 17:10:45 2013
Reported on Tue Oct 15 17:12:03 2013

Filename/usr/share/perl5/Net/LDAP/Message.pm
StatementsExecuted 27 statements in 2.01ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1115.41ms6.89msNet::LDAP::Message::::BEGIN@7 Net::LDAP::Message::BEGIN@7
111780µs72.0msNet::LDAP::Message::::BEGIN@8 Net::LDAP::Message::BEGIN@8
11118µs24µsNet::LDAP::Message::::BEGIN@9 Net::LDAP::Message::BEGIN@9
11117µs56µsNet::LDAP::Message::::BEGIN@10 Net::LDAP::Message::BEGIN@10
11112µs47µsNet::LDAP::Message::Dummy::::BEGIN@251Net::LDAP::Message::Dummy::BEGIN@251
0000s0sNet::LDAP::Compare::::is_error Net::LDAP::Compare::is_error
0000s0sNet::LDAP::Message::Dummy::::abandonNet::LDAP::Message::Dummy::abandon
0000s0sNet::LDAP::Message::Dummy::::codeNet::LDAP::Message::Dummy::code
0000s0sNet::LDAP::Message::Dummy::::decodeNet::LDAP::Message::Dummy::decode
0000s0sNet::LDAP::Message::Dummy::::dnNet::LDAP::Message::Dummy::dn
0000s0sNet::LDAP::Message::Dummy::::doneNet::LDAP::Message::Dummy::done
0000s0sNet::LDAP::Message::Dummy::::errorNet::LDAP::Message::Dummy::error
0000s0sNet::LDAP::Message::Dummy::::syncNet::LDAP::Message::Dummy::sync
0000s0sNet::LDAP::Message::::NewMesgID Net::LDAP::Message::NewMesgID
0000s0sNet::LDAP::Message::::abandon Net::LDAP::Message::abandon
0000s0sNet::LDAP::Message::::callback Net::LDAP::Message::callback
0000s0sNet::LDAP::Message::::code Net::LDAP::Message::code
0000s0sNet::LDAP::Message::::control Net::LDAP::Message::control
0000s0sNet::LDAP::Message::::decode Net::LDAP::Message::decode
0000s0sNet::LDAP::Message::::dn Net::LDAP::Message::dn
0000s0sNet::LDAP::Message::::done Net::LDAP::Message::done
0000s0sNet::LDAP::Message::::encode Net::LDAP::Message::encode
0000s0sNet::LDAP::Message::::error Net::LDAP::Message::error
0000s0sNet::LDAP::Message::::error_desc Net::LDAP::Message::error_desc
0000s0sNet::LDAP::Message::::error_name Net::LDAP::Message::error_name
0000s0sNet::LDAP::Message::::error_text Net::LDAP::Message::error_text
0000s0sNet::LDAP::Message::::is_error Net::LDAP::Message::is_error
0000s0sNet::LDAP::Message::::mesg_id Net::LDAP::Message::mesg_id
0000s0sNet::LDAP::Message::::new Net::LDAP::Message::new
0000s0sNet::LDAP::Message::::parent Net::LDAP::Message::parent
0000s0sNet::LDAP::Message::::pdu Net::LDAP::Message::pdu
0000s0sNet::LDAP::Message::::referrals Net::LDAP::Message::referrals
0000s0sNet::LDAP::Message::::saslref Net::LDAP::Message::saslref
0000s0sNet::LDAP::Message::::server_error Net::LDAP::Message::server_error
0000s0sNet::LDAP::Message::::set_error Net::LDAP::Message::set_error
0000s0sNet::LDAP::Message::::sync Net::LDAP::Message::sync
Call graph for these subroutines as a Graphviz dot language file.
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
5package Net::LDAP::Message;
6
73158µs27.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
use Net::LDAP::Constant qw(LDAP_SUCCESS LDAP_COMPARE_TRUE LDAP_COMPARE_FALSE);
# spent 6.89ms making 1 call to Net::LDAP::Message::BEGIN@7 # spent 353µs making 1 call to Exporter::import
83197µs272.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
use Net::LDAP::ASN qw(LDAPRequest);
# spent 72.0ms making 1 call to Net::LDAP::Message::BEGIN@8 # spent 38µs making 1 call to Net::LDAP::ASN::import
9340µs230µ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
use strict;
# spent 24µs making 1 call to Net::LDAP::Message::BEGIN@9 # spent 6µs making 1 call to strict::import
1031.33ms295µ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
use vars qw($VERSION);
# spent 56µs making 1 call to Net::LDAP::Message::BEGIN@10 # spent 39µs making 1 call to vars::import
11
1211µs$VERSION = "1.11";
13
141500nsmy $MsgID = 0;
15
16# We do this here so when we add threading we can lock it
17sub NewMesgID {
18 $MsgID = 1 if ++$MsgID > 65535;
19 $MsgID;
20}
21
22sub 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
38sub 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
48sub done {
49 my $self = shift;
50
51 exists $self->{resultCode};
52}
53
54sub 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
64sub referrals {
65 my $self = shift;
66
67 $self->sync unless exists $self->{resultCode};
68
69 exists $self->{referral}
70 ? @{$self->{referral}}
71 : ();
72}
73
74sub 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
84sub 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
96sub 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
104sub error_name {
105 require Net::LDAP::Util;
106 Net::LDAP::Util::ldap_error_name(shift->code);
107}
108
109sub error_text {
110 require Net::LDAP::Util;
111 Net::LDAP::Util::ldap_error_text(shift->code);
112}
113
114sub error_desc {
115 require Net::LDAP::Util;
116 Net::LDAP::Util::ldap_error_desc(shift->code);
117}
118
119sub 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
135sub 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
170sub 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
180sub 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
191sub encode {
192 my $self = shift;
193
194 $self->{pdu} = $LDAPRequest->encode(@_, messageID => $self->{mesgid})
195 or return;
196 1;
197}
198
199sub 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
224sub pdu { shift->{pdu} }
225sub callback { shift->{callback} }
226sub parent { shift->{parent}->outer }
227sub mesg_id { shift->{mesgid} }
228sub is_error { shift->code }
229
230##
231##
232##
233
234
235112µs@Net::LDAP::Add::ISA = qw(Net::LDAP::Message);
23615µs@Net::LDAP::Delete::ISA = qw(Net::LDAP::Message);
23715µs@Net::LDAP::Modify::ISA = qw(Net::LDAP::Message);
23814µs@Net::LDAP::ModDN::ISA = qw(Net::LDAP::Message);
23914µs@Net::LDAP::Compare::ISA = qw(Net::LDAP::Message);
24015µs@Net::LDAP::Unbind::ISA = qw(Net::LDAP::Message::Dummy);
24114µs@Net::LDAP::Abandon::ISA = qw(Net::LDAP::Message::Dummy);
242
243sub 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{
25011µs package Net::LDAP::Message::Dummy;
2513227µs282µ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
use vars qw(@ISA);
# spent 47µs making 1 call to Net::LDAP::Message::Dummy::BEGIN@251 # spent 35µs making 1 call to vars::import
25217µ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
26318µs1;