← Index
NYTProf Performance Profile   « block view • line view • sub view »
For mentat.storage.mongo.pl
  Run on Tue Jun 24 10:04:38 2014
Reported on Tue Jun 24 10:05:07 2014

Filename/usr/share/perl5/Readonly.pm
StatementsExecuted 53 statements in 2.02ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11148µs48µsReadonly::Array::::BEGIN@100 Readonly::Array::BEGIN@100
11140µs40µsboolean::::BEGIN@13 boolean::BEGIN@13
22124µs45µsReadonly::::Scalar Readonly::Scalar
11110µs40µsReadonly::::BEGIN@32 Readonly::BEGIN@32
1119µs29µsReadonly::::BEGIN@170 Readonly::BEGIN@170
2118µs8µsReadonly::::_is_badtype Readonly::_is_badtype
1118µs11µsboolean::::BEGIN@14.11 boolean::BEGIN@14.11
1116µs56µsReadonly::::BEGIN@171 Readonly::BEGIN@171
1116µs41µsReadonly::::BEGIN@35 Readonly::BEGIN@35
211700ns700nsReadonly::::CORE:subst Readonly::CORE:subst (opcode)
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__[:112] Readonly::Array::__ANON__[:112]
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__[:162] Readonly::Hash::__ANON__[:162]
0000s0sReadonly::::Scalar1 Readonly::Scalar1
0000s0sReadonly::Scalar::::FETCHReadonly::Scalar::FETCH
0000s0sReadonly::Scalar::::TIESCALARReadonly::Scalar::TIESCALAR
0000s0sReadonly::Scalar::::__ANON__[:69]Readonly::Scalar::__ANON__[:69]
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=head1 NAME
2
3Readonly - Facility for creating read-only scalars, arrays, hashes.
4
5=head1 VERSION
6
7This documentation describes version 1.03 of Readonly.pm, April 20, 2004.
8
9=cut
10
11# Rest of documentation is after __END__.
12
13265µs140µs
# spent 40µs within boolean::BEGIN@13 which was called: # once (40µs+0s) by boolean::BEGIN@31 at line 13
use 5.005;
# spent 40µs making 1 call to boolean::BEGIN@13
14280µs214µs
# spent 11µs (8+3) within boolean::BEGIN@14.11 which was called: # once (8µs+3µs) by boolean::BEGIN@31 at line 14
use strict;
# spent 11µs making 1 call to boolean::BEGIN@14.11 # spent 3µs making 1 call to strict::import
15#use warnings;
16#no warnings 'uninitialized';
17
18package Readonly;
191700ns$Readonly::VERSION = '1.03'; # Also change in the documentation!
20
21# Autocroak (Thanks, MJD)
22# Only load Carp.pm if module is croaking.
23sub croak
24{
25 require Carp;
26 goto &Carp::croak;
27}
28
29# These functions may be overridden by Readonly::XS, if installed.
30sub is_sv_readonly ($) { 0 }
31sub make_sv_readonly ($) { die "make_sv_readonly called but not overridden" }
32230µs271µs
# spent 40µs (10+31) within Readonly::BEGIN@32 which was called: # once (10µs+31µs) by boolean::BEGIN@31 at line 32
use vars qw/$XSokay/; # Set to true in Readonly::XS, if available
# spent 40µs making 1 call to Readonly::BEGIN@32 # spent 31µs making 1 call to vars::import
33
34# Common error messages, or portions thereof
352311µs277µs
# spent 41µs (6+35) within Readonly::BEGIN@35 which was called: # once (6µs+35µs) by boolean::BEGIN@31 at line 35
use vars qw/$MODIFY $REASSIGN $ODDHASH/;
# spent 41µs making 1 call to Readonly::BEGIN@35 # spent 35µs making 1 call to vars::import
361400ns$MODIFY = 'Modification of a read-only value attempted';
371100ns$REASSIGN = 'Attempt to reassign a readonly';
381200ns$ODDHASH = 'May not store an odd number of values in a hash';
39
40# See if we can use the XS stuff.
411200ns$Readonly::XS::MAGIC_COOKIE = "Do NOT use or require Readonly::XS unless you're me.";
42128µseval 'use Readonly::XS';
# spent 92µs executing statements in string eval
# includes 316µs spent executing 1 call to 1 sub defined therein.
43
44
45# ----------------
46# Read-only scalars
47# ----------------
48package Readonly::Scalar;
49
50sub TIESCALAR
51{
52 my $whence = (caller 2)[3]; # Check if naughty user is trying to tie directly.
53 Readonly::croak "Invalid tie" unless $whence && $whence =~ /^Readonly::(?:Scalar1?|Readonly)$/;
54 my $class = shift;
55 Readonly::croak "No value specified for readonly scalar" unless @_;
56 Readonly::croak "Too many values specified for readonly scalar" unless @_ == 1;
57
58 my $value = shift;
59 return bless \$value, $class;
60}
61
62sub FETCH
63{
64 my $self = shift;
65 return $$self;
66}
67
68*STORE = *UNTIE =
6913µs sub {Readonly::croak $Readonly::MODIFY};
70
71
72# ----------------
73# Read-only arrays
74# ----------------
75package Readonly::Array;
76
77sub TIEARRAY
78{
79 my $whence = (caller 1)[3]; # Check if naughty user is trying to tie directly.
80 Readonly::croak "Invalid tie" unless $whence =~ /^Readonly::Array1?$/;
81 my $class = shift;
82 my @self = @_;
83
84 return bless \@self, $class;
85}
86
87sub FETCH
88{
89 my $self = shift;
90 my $index = shift;
91 return $self->[$index];
92}
93
94sub FETCHSIZE
95{
96 my $self = shift;
97 return scalar @$self;
98}
99
100
# spent 48µs within Readonly::Array::BEGIN@100 which was called: # once (48µs+0s) by boolean::BEGIN@31 at line 109
BEGIN {
101149µs eval q{
102 sub EXISTS
103 {
104 my $self = shift;
105 my $index = shift;
106 return exists $self->[$index];
107 }
108 } if $] >= 5.006; # couldn't do "exists" on arrays before then
1091250µs148µs}
# spent 48µs making 1 call to Readonly::Array::BEGIN@100
110
111*STORE = *STORESIZE = *EXTEND = *PUSH = *POP = *UNSHIFT = *SHIFT = *SPLICE = *CLEAR = *UNTIE =
11213µs sub {Readonly::croak $Readonly::MODIFY};
113
114
115# ----------------
116# Read-only hashes
117# ----------------
118package Readonly::Hash;
119
120sub TIEHASH
121{
122 my $whence = (caller 1)[3]; # Check if naughty user is trying to tie directly.
123 Readonly::croak "Invalid tie" unless $whence =~ /^Readonly::Hash1?$/;
124
125 my $class = shift;
126 # must have an even number of values
127 Readonly::croak $Readonly::ODDHASH unless (@_ %2 == 0);
128
129 my %self = @_;
130 return bless \%self, $class;
131}
132
133sub FETCH
134{
135 my $self = shift;
136 my $key = shift;
137
138 return $self->{$key};
139}
140
141sub EXISTS
142{
143 my $self = shift;
144 my $key = shift;
145 return exists $self->{$key};
146}
147
148sub FIRSTKEY
149{
150 my $self = shift;
151 my $dummy = keys %$self;
152 return scalar each %$self;
153}
154
155sub NEXTKEY
156{
157 my $self = shift;
158 return scalar each %$self;
159}
160
161*STORE = *DELETE = *CLEAR = *UNTIE =
16212µs sub {Readonly::croak $Readonly::MODIFY};
163
164
165# ----------------------------------------------------------------
166# Main package, containing convenience functions (so callers won't
167# have to explicitly tie the variables themselves).
168# ----------------------------------------------------------------
169package Readonly;
170227µs249µs
# spent 29µs (9+20) within Readonly::BEGIN@170 which was called: # once (9µs+20µs) by boolean::BEGIN@31 at line 170
use Exporter;
# spent 29µs making 1 call to Readonly::BEGIN@170 # spent 20µs making 1 call to Exporter::import
1712891µs2105µs
# spent 56µs (6+49) within Readonly::BEGIN@171 which was called: # once (6µs+49µs) by boolean::BEGIN@31 at line 171
use vars qw/@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS/;
# spent 56µs making 1 call to Readonly::BEGIN@171 # spent 49µs making 1 call to vars::import
17214µspush @ISA, 'Exporter';
1731300nspush @EXPORT, qw/Readonly/;
17411µspush @EXPORT_OK, qw/Scalar Array Hash Scalar1 Array1 Hash1/;
175
176# Predeclare the following, so we can use them recursively
177sub Scalar ($$);
178sub Array (\@;@);
179sub Hash (\%;@);
180
181# Returns true if a string begins with "Readonly::"
182# Used to prevent reassignment of Readonly variables.
183sub _is_badtype
184
# spent 8µs (8+700ns) within Readonly::_is_badtype which was called 2 times, avg 4µs/call: # 2 times (8µs+700ns) by Readonly::Scalar at line 249, avg 4µs/call
{
185610µs my $type = $_[0];
1862700ns return lc $type if $type =~ s/^Readonly:://;
# spent 700ns making 2 calls to Readonly::CORE:subst, avg 350ns/call
187 return;
188}
189
190# Shallow Readonly scalar
191sub Scalar1 ($$)
192{
193 croak "$REASSIGN scalar" if is_sv_readonly $_[0];
194 my $badtype = _is_badtype (ref tied $_[0]);
195 croak "$REASSIGN $badtype" if $badtype;
196
197 # xs method: flag scalar as readonly
198 if ($XSokay)
199 {
200 $_[0] = $_[1];
201 make_sv_readonly $_[0];
202 return;
203 }
204
205 # pure-perl method: tied scalar
206 my $tieobj = eval {tie $_[0], 'Readonly::Scalar', $_[1]};
207 if ($@)
208 {
209 croak "$REASSIGN scalar" if substr($@,0,43) eq $MODIFY;
210 die $@; # some other error?
211 }
212 return $tieobj;
213}
214
215# Shallow Readonly array
216sub Array1 (\@;@)
217{
218 my $badtype = _is_badtype (ref tied $_[0]);
219 croak "$REASSIGN $badtype" if $badtype;
220
221 my $aref = shift;
222 return tie @$aref, 'Readonly::Array', @_;
223}
224
225# Shallow Readonly hash
226sub Hash1 (\%;@)
227{
228 my $badtype = _is_badtype (ref tied $_[0]);
229 croak "$REASSIGN $badtype" if $badtype;
230
231 my $href = shift;
232
233 # If only one value, and it's a hashref, expand it
234 if (@_ == 1 && ref $_[0] eq 'HASH')
235 {
236 return tie %$href, 'Readonly::Hash', %{$_[0]};
237 }
238
239 # otherwise, must have an even number of values
240 croak $ODDHASH unless (@_%2 == 0);
241
242 return tie %$href, 'Readonly::Hash', @_;
243}
244
245# Deep Readonly scalar
246sub Scalar ($$)
247
# spent 45µs (24+21) within Readonly::Scalar which was called 2 times, avg 22µs/call: # once (16µs+17µs) by boolean::BEGIN@31 at line 40 of boolean.pm # once (7µs+4µs) by boolean::BEGIN@31 at line 41 of boolean.pm
{
2482036µs211µs croak "$REASSIGN scalar" if is_sv_readonly $_[0];
# spent 11µs making 2 calls to Readonly::XS::is_sv_readonly, avg 6µs/call
24928µs my $badtype = _is_badtype (ref tied $_[0]);
# spent 8µs making 2 calls to Readonly::_is_badtype, avg 4µs/call
250 croak "$REASSIGN $badtype" if $badtype;
251
252 my $value = $_[1];
253
254 # Recursively check passed element for references; if any, make them Readonly
255 foreach ($value)
256 {
257 if (ref eq 'SCALAR') {Scalar my $v => $$_; $_ = \$v}
258 elsif (ref eq 'ARRAY') {Array my @v => @$_; $_ = \@v}
259 elsif (ref eq 'HASH') {Hash my %v => $_; $_ = \%v}
260 }
261
262 # xs method: flag scalar as readonly
263 if ($XSokay)
264 {
265 $_[0] = $value;
26621µs make_sv_readonly $_[0];
# spent 1µs making 2 calls to Readonly::XS::make_sv_readonly, avg 700ns/call
267 return;
268 }
269
270 # pure-perl method: tied scalar
271 my $tieobj = eval {tie $_[0], 'Readonly::Scalar', $value};
272 if ($@)
273 {
274 croak "$REASSIGN scalar" if substr($@,0,43) eq $MODIFY;
275 die $@; # some other error?
276 }
277 return $tieobj;
278}
279
280# Deep Readonly array
281sub Array (\@;@)
282{
283 my $badtype = _is_badtype (ref tied @{$_[0]});
284 croak "$REASSIGN $badtype" if $badtype;
285
286 my $aref = shift;
287 my @values = @_;
288
289 # Recursively check passed elements for references; if any, make them Readonly
290 foreach (@values)
291 {
292 if (ref eq 'SCALAR') {Scalar my $v => $$_; $_ = \$v}
293 elsif (ref eq 'ARRAY') {Array my @v => @$_; $_ = \@v}
294 elsif (ref eq 'HASH') {Hash my %v => $_; $_ = \%v}
295 }
296 # Lastly, tie the passed reference
297 return tie @$aref, 'Readonly::Array', @values;
298}
299
300# Deep Readonly hash
301sub Hash (\%;@)
302{
303 my $badtype = _is_badtype (ref tied %{$_[0]});
304 croak "$REASSIGN $badtype" if $badtype;
305
306 my $href = shift;
307 my @values = @_;
308
309 # If only one value, and it's a hashref, expand it
310 if (@_ == 1 && ref $_[0] eq 'HASH')
311 {
312 @values = %{$_[0]};
313 }
314
315 # otherwise, must have an even number of values
316 croak $ODDHASH unless (@values %2 == 0);
317
318 # Recursively check passed elements for references; if any, make them Readonly
319 foreach (@values)
320 {
321 if (ref eq 'SCALAR') {Scalar my $v => $$_; $_ = \$v}
322 elsif (ref eq 'ARRAY') {Array my @v => @$_; $_ = \@v}
323 elsif (ref eq 'HASH') {Hash my %v => $_; $_ = \%v}
324 }
325
326 return tie %$href, 'Readonly::Hash', @values;
327}
328
329
330# Common entry-point for all supported data types
3311216µseval q{sub Readonly} . ( $] < 5.008 ? '' : '(\[$@%]@)' ) . <<'SUB_READONLY';
332{
333 if (ref $_[0] eq 'SCALAR')
334 {
335 croak $MODIFY if is_sv_readonly ${$_[0]};
336 my $badtype = _is_badtype (ref tied ${$_[0]});
337 croak "$REASSIGN $badtype" if $badtype;
338 croak "Readonly scalar must have only one value" if @_ > 2;
339
340 my $tieobj = eval {tie ${$_[0]}, 'Readonly::Scalar', $_[1]};
341 # Tie may have failed because user tried to tie a constant, or we screwed up somehow.
342 if ($@)
343 {
344 croak $MODIFY if $@ =~ /^$MODIFY at/; # Point the finger at the user.
345 die "$@\n"; # Not a modify read-only message; must be our fault.
346 }
347 return $tieobj;
348 }
349 elsif (ref $_[0] eq 'ARRAY')
350 {
351 my $aref = shift;
352 return Array @$aref, @_;
353 }
354 elsif (ref $_[0] eq 'HASH')
355 {
356 my $href = shift;
357 croak $ODDHASH if @_%2 != 0 && !(@_ == 1 && ref $_[0] eq 'HASH');
358 return Hash %$href, @_;
359 }
360 elsif (ref $_[0])
361 {
362 croak "Readonly only supports scalar, array, and hash variables.";
363 }
364 else
365 {
366 croak "First argument to Readonly must be a reference.";
367 }
368}
369SUB_READONLY
370
371
37219µs1;
373__END__
 
# spent 700ns within Readonly::CORE:subst which was called 2 times, avg 350ns/call: # 2 times (700ns+0s) by Readonly::_is_badtype at line 186, avg 350ns/call
sub Readonly::CORE:subst; # opcode