← 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 11:58:52 2013
Reported on Tue Oct 15 12:02:21 2013

Filename/usr/share/perl5/Readonly.pm
StatementsExecuted 33 statements in 2.78ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
111105µs105µsReadonly::Array::::BEGIN@107 Readonly::Array::BEGIN@107
11140µs40µsKoha::Calendar::::BEGIN@20 Koha::Calendar::BEGIN@20
11123µs67µsReadonly::::BEGIN@177 Readonly::BEGIN@177
11116µs108µsReadonly::::BEGIN@178 Readonly::BEGIN@178
11113µs57µsReadonly::::BEGIN@39 Readonly::BEGIN@39
11113µs19µsKoha::Calendar::::BEGIN@21 Koha::Calendar::BEGIN@21
11112µs60µsReadonly::::BEGIN@42 Readonly::BEGIN@42
0000s0sReadonly::::Array Readonly::Array
0000s0sReadonly::::Array1 Readonly::Array1
0000s0sReadonly::Array::::FETCH Readonly::Array::FETCH
0000s0sReadonly::Array::::FETCHSIZE Readonly::Array::FETCHSIZE
0000s0sReadonly::Array::::TIEARRAY Readonly::Array::TIEARRAY
0000s0sReadonly::Array::::__ANON__[:119] Readonly::Array::__ANON__[:119]
0000s0sReadonly::::Hash Readonly::Hash
0000s0sReadonly::::Hash1 Readonly::Hash1
0000s0sReadonly::Hash::::EXISTS Readonly::Hash::EXISTS
0000s0sReadonly::Hash::::FETCH Readonly::Hash::FETCH
0000s0sReadonly::Hash::::FIRSTKEY Readonly::Hash::FIRSTKEY
0000s0sReadonly::Hash::::NEXTKEY Readonly::Hash::NEXTKEY
0000s0sReadonly::Hash::::TIEHASH Readonly::Hash::TIEHASH
0000s0sReadonly::Hash::::__ANON__[:169] Readonly::Hash::__ANON__[:169]
0000s0sReadonly::::Scalar Readonly::Scalar
0000s0sReadonly::::Scalar1 Readonly::Scalar1
0000s0sReadonly::Scalar::::FETCHReadonly::Scalar::FETCH
0000s0sReadonly::Scalar::::TIESCALARReadonly::Scalar::TIESCALAR
0000s0sReadonly::Scalar::::__ANON__[:76]Readonly::Scalar::__ANON__[:76]
0000s0sReadonly::::_is_badtype Readonly::_is_badtype
0000s0sReadonly::::croak Readonly::croak
0000s0sReadonly::::is_sv_readonly Readonly::is_sv_readonly
0000s0sReadonly::::make_sv_readonly Readonly::make_sv_readonly
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1=for gpg
2
- -
18# Rest of documentation is after __END__.
19
20360µs140µs
# spent 40µs within Koha::Calendar::BEGIN@20 which was called: # once (40µs+0s) by Koha::Calendar::BEGIN@11 at line 20
use 5.005;
# spent 40µs making 1 call to Koha::Calendar::BEGIN@20
213152µs226µs
# spent 19µs (13+7) within Koha::Calendar::BEGIN@21 which was called: # once (13µs+7µs) by Koha::Calendar::BEGIN@11 at line 21
use strict;
# spent 19µs making 1 call to Koha::Calendar::BEGIN@21 # spent 7µs making 1 call to strict::import
22#use warnings;
23#no warnings 'uninitialized';
24
25package Readonly;
2611µs$Readonly::VERSION = '1.03'; # Also change in the documentation!
27
28# Autocroak (Thanks, MJD)
29# Only load Carp.pm if module is croaking.
30sub croak
31{
32 require Carp;
33 goto &Carp::croak;
34}
35
36# These functions may be overridden by Readonly::XS, if installed.
37sub is_sv_readonly ($) { 0 }
38sub make_sv_readonly ($) { die "make_sv_readonly called but not overridden" }
39338µs2100µs
# spent 57µs (13+43) within Readonly::BEGIN@39 which was called: # once (13µs+43µs) by Koha::Calendar::BEGIN@11 at line 39
use vars qw/$XSokay/; # Set to true in Readonly::XS, if available
# spent 57µs making 1 call to Readonly::BEGIN@39 # spent 43µs making 1 call to vars::import
40
41# Common error messages, or portions thereof
423523µs2108µs
# spent 60µs (12+48) within Readonly::BEGIN@42 which was called: # once (12µs+48µs) by Koha::Calendar::BEGIN@11 at line 42
use vars qw/$MODIFY $REASSIGN $ODDHASH/;
# spent 60µs making 1 call to Readonly::BEGIN@42 # spent 48µs making 1 call to vars::import
431500ns$MODIFY = 'Modification of a read-only value attempted';
441300ns$REASSIGN = 'Attempt to reassign a readonly';
451300ns$ODDHASH = 'May not store an odd number of values in a hash';
46
47# See if we can use the XS stuff.
481400ns$Readonly::XS::MAGIC_COOKIE = "Do NOT use or require Readonly::XS unless you're me.";
49148µseval 'use Readonly::XS';
# spent 108µs executing statements in string eval
# includes 452µs spent executing 1 call to 1 sub defined therein.
50
51
52# ----------------
53# Read-only scalars
54# ----------------
55package Readonly::Scalar;
56
57sub TIESCALAR
58{
59 my $whence = (caller 2)[3]; # Check if naughty user is trying to tie directly.
60 Readonly::croak "Invalid tie" unless $whence && $whence =~ /^Readonly::(?:Scalar1?|Readonly)$/;
61 my $class = shift;
62 Readonly::croak "No value specified for readonly scalar" unless @_;
63 Readonly::croak "Too many values specified for readonly scalar" unless @_ == 1;
64
65 my $value = shift;
66 return bless \$value, $class;
67}
68
69sub FETCH
70{
71 my $self = shift;
72 return $$self;
73}
74
75*STORE = *UNTIE =
7614µs sub {Readonly::croak $Readonly::MODIFY};
77
78
79# ----------------
80# Read-only arrays
81# ----------------
82package Readonly::Array;
83
84sub TIEARRAY
85{
86 my $whence = (caller 1)[3]; # Check if naughty user is trying to tie directly.
87 Readonly::croak "Invalid tie" unless $whence =~ /^Readonly::Array1?$/;
88 my $class = shift;
89 my @self = @_;
90
91 return bless \@self, $class;
92}
93
94sub FETCH
95{
96 my $self = shift;
97 my $index = shift;
98 return $self->[$index];
99}
100
101sub FETCHSIZE
102{
103 my $self = shift;
104 return scalar @$self;
105}
106
107
# spent 105µs within Readonly::Array::BEGIN@107 which was called: # once (105µs+0s) by Koha::Calendar::BEGIN@11 at line 116
BEGIN {
1081104µs eval q{
109 sub EXISTS
110 {
111 my $self = shift;
112 my $index = shift;
113 return exists $self->[$index];
114 }
115 } if $] >= 5.006; # couldn't do "exists" on arrays before then
1161351µs1105µs}
# spent 105µs making 1 call to Readonly::Array::BEGIN@107
117
118*STORE = *STORESIZE = *EXTEND = *PUSH = *POP = *UNSHIFT = *SHIFT = *SPLICE = *CLEAR = *UNTIE =
11914µs sub {Readonly::croak $Readonly::MODIFY};
120
121
122# ----------------
123# Read-only hashes
124# ----------------
125package Readonly::Hash;
126
127sub TIEHASH
128{
129 my $whence = (caller 1)[3]; # Check if naughty user is trying to tie directly.
130 Readonly::croak "Invalid tie" unless $whence =~ /^Readonly::Hash1?$/;
131
132 my $class = shift;
133 # must have an even number of values
134 Readonly::croak $Readonly::ODDHASH unless (@_ %2 == 0);
135
136 my %self = @_;
137 return bless \%self, $class;
138}
139
140sub FETCH
141{
142 my $self = shift;
143 my $key = shift;
144
145 return $self->{$key};
146}
147
148sub EXISTS
149{
150 my $self = shift;
151 my $key = shift;
152 return exists $self->{$key};
153}
154
155sub FIRSTKEY
156{
157 my $self = shift;
158 my $dummy = keys %$self;
159 return scalar each %$self;
160}
161
162sub NEXTKEY
163{
164 my $self = shift;
165 return scalar each %$self;
166}
167
168*STORE = *DELETE = *CLEAR = *UNTIE =
16913µs sub {Readonly::croak $Readonly::MODIFY};
170
171
172# ----------------------------------------------------------------
173# Main package, containing convenience functions (so callers won't
174# have to explicitly tie the variables themselves).
175# ----------------------------------------------------------------
176package Readonly;
177350µs2112µs
# spent 67µs (23+45) within Readonly::BEGIN@177 which was called: # once (23µs+45µs) by Koha::Calendar::BEGIN@11 at line 177
use Exporter;
# spent 67µs making 1 call to Readonly::BEGIN@177 # spent 44µs making 1 call to Exporter::import
17831.16ms2201µs
# spent 108µs (16+93) within Readonly::BEGIN@178 which was called: # once (16µs+93µs) by Koha::Calendar::BEGIN@11 at line 178
use vars qw/@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS/;
# spent 108µs making 1 call to Readonly::BEGIN@178 # spent 93µs making 1 call to vars::import
17917µspush @ISA, 'Exporter';
1801600nspush @EXPORT, qw/Readonly/;
18111µspush @EXPORT_OK, qw/Scalar Array Hash Scalar1 Array1 Hash1/;
182
183# Predeclare the following, so we can use them recursively
184sub Scalar ($$);
185sub Array (\@;@);
186sub Hash (\%;@);
187
188# Returns true if a string begins with "Readonly::"
189# Used to prevent reassignment of Readonly variables.
190sub _is_badtype
191{
192 my $type = $_[0];
193 return lc $type if $type =~ s/^Readonly:://;
194 return;
195}
196
197# Shallow Readonly scalar
198sub Scalar1 ($$)
199{
200 croak "$REASSIGN scalar" if is_sv_readonly $_[0];
201 my $badtype = _is_badtype (ref tied $_[0]);
202 croak "$REASSIGN $badtype" if $badtype;
203
204 # xs method: flag scalar as readonly
205 if ($XSokay)
206 {
207 $_[0] = $_[1];
208 make_sv_readonly $_[0];
209 return;
210 }
211
212 # pure-perl method: tied scalar
213 my $tieobj = eval {tie $_[0], 'Readonly::Scalar', $_[1]};
214 if ($@)
215 {
216 croak "$REASSIGN scalar" if substr($@,0,43) eq $MODIFY;
217 die $@; # some other error?
218 }
219 return $tieobj;
220}
221
222# Shallow Readonly array
223sub Array1 (\@;@)
224{
225 my $badtype = _is_badtype (ref tied $_[0]);
226 croak "$REASSIGN $badtype" if $badtype;
227
228 my $aref = shift;
229 return tie @$aref, 'Readonly::Array', @_;
230}
231
232# Shallow Readonly hash
233sub Hash1 (\%;@)
234{
235 my $badtype = _is_badtype (ref tied $_[0]);
236 croak "$REASSIGN $badtype" if $badtype;
237
238 my $href = shift;
239
240 # If only one value, and it's a hashref, expand it
241 if (@_ == 1 && ref $_[0] eq 'HASH')
242 {
243 return tie %$href, 'Readonly::Hash', %{$_[0]};
244 }
245
246 # otherwise, must have an even number of values
247 croak $ODDHASH unless (@_%2 == 0);
248
249 return tie %$href, 'Readonly::Hash', @_;
250}
251
252# Deep Readonly scalar
253sub Scalar ($$)
254{
255 croak "$REASSIGN scalar" if is_sv_readonly $_[0];
256 my $badtype = _is_badtype (ref tied $_[0]);
257 croak "$REASSIGN $badtype" if $badtype;
258
259 my $value = $_[1];
260
261 # Recursively check passed element for references; if any, make them Readonly
262 foreach ($value)
263 {
264 if (ref eq 'SCALAR') {Scalar my $v => $$_; $_ = \$v}
265 elsif (ref eq 'ARRAY') {Array my @v => @$_; $_ = \@v}
266 elsif (ref eq 'HASH') {Hash my %v => $_; $_ = \%v}
267 }
268
269 # xs method: flag scalar as readonly
270 if ($XSokay)
271 {
272 $_[0] = $value;
273 make_sv_readonly $_[0];
274 return;
275 }
276
277 # pure-perl method: tied scalar
278 my $tieobj = eval {tie $_[0], 'Readonly::Scalar', $value};
279 if ($@)
280 {
281 croak "$REASSIGN scalar" if substr($@,0,43) eq $MODIFY;
282 die $@; # some other error?
283 }
284 return $tieobj;
285}
286
287# Deep Readonly array
288sub Array (\@;@)
289{
290 my $badtype = _is_badtype (ref tied @{$_[0]});
291 croak "$REASSIGN $badtype" if $badtype;
292
293 my $aref = shift;
294 my @values = @_;
295
296 # Recursively check passed elements for references; if any, make them Readonly
297 foreach (@values)
298 {
299 if (ref eq 'SCALAR') {Scalar my $v => $$_; $_ = \$v}
300 elsif (ref eq 'ARRAY') {Array my @v => @$_; $_ = \@v}
301 elsif (ref eq 'HASH') {Hash my %v => $_; $_ = \%v}
302 }
303 # Lastly, tie the passed reference
304 return tie @$aref, 'Readonly::Array', @values;
305}
306
307# Deep Readonly hash
308sub Hash (\%;@)
309{
310 my $badtype = _is_badtype (ref tied %{$_[0]});
311 croak "$REASSIGN $badtype" if $badtype;
312
313 my $href = shift;
314 my @values = @_;
315
316 # If only one value, and it's a hashref, expand it
317 if (@_ == 1 && ref $_[0] eq 'HASH')
318 {
319 @values = %{$_[0]};
320 }
321
322 # otherwise, must have an even number of values
323 croak $ODDHASH unless (@values %2 == 0);
324
325 # Recursively check passed elements for references; if any, make them Readonly
326 foreach (@values)
327 {
328 if (ref eq 'SCALAR') {Scalar my $v => $$_; $_ = \$v}
329 elsif (ref eq 'ARRAY') {Array my @v => @$_; $_ = \@v}
330 elsif (ref eq 'HASH') {Hash my %v => $_; $_ = \%v}
331 }
332
333 return tie %$href, 'Readonly::Hash', @values;
334}
335
336
337# Common entry-point for all supported data types
3381253µseval q{sub Readonly} . ( $] < 5.008 ? '' : '(\[$@%]@)' ) . <<'SUB_READONLY';
339{
340 if (ref $_[0] eq 'SCALAR')
341 {
342 croak $MODIFY if is_sv_readonly ${$_[0]};
343 my $badtype = _is_badtype (ref tied ${$_[0]});
344 croak "$REASSIGN $badtype" if $badtype;
345 croak "Readonly scalar must have only one value" if @_ > 2;
346
347 my $tieobj = eval {tie ${$_[0]}, 'Readonly::Scalar', $_[1]};
348 # Tie may have failed because user tried to tie a constant, or we screwed up somehow.
349 if ($@)
350 {
351 croak $MODIFY if $@ =~ /^$MODIFY at/; # Point the finger at the user.
352 die "$@\n"; # Not a modify read-only message; must be our fault.
353 }
354 return $tieobj;
355 }
356 elsif (ref $_[0] eq 'ARRAY')
357 {
358 my $aref = shift;
359 return Array @$aref, @_;
360 }
361 elsif (ref $_[0] eq 'HASH')
362 {
363 my $href = shift;
364 croak $ODDHASH if @_%2 != 0 && !(@_ == 1 && ref $_[0] eq 'HASH');
365 return Hash %$href, @_;
366 }
367 elsif (ref $_[0])
368 {
369 croak "Readonly only supports scalar, array, and hash variables.";
370 }
371 else
372 {
373 croak "First argument to Readonly must be a reference.";
374 }
375}
376SUB_READONLY
377
378
379120µs1;
380__END__
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.