← Index
NYTProf Performance Profile   « block view • line view • sub view »
For bin/dpath
  Run on Tue Jun 5 15:31:33 2012
Reported on Tue Jun 5 15:31:38 2012

Filename/home/ss5/perl5/perlbrew/perls/perl-5.14.1/lib/site_perl/5.14.1/Safe.pm
StatementsExecuted 387 statements in 15.4ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1119.51ms12.4msSafe::::BEGIN@34Safe::BEGIN@34
1113.21ms19.7msSafe::::BEGIN@46Safe::BEGIN@46
2212.61ms3.06msSafe::::share_fromSafe::share_from
111362µs136msSafe::::CORE:regcompSafe::CORE:regcomp (opcode)
5911269µs269µsSafe::::CORE:substSafe::CORE:subst (opcode)
211156µs156µsSafe::::share_recordSafe::share_record
111153µs630µsSafe::::BEGIN@30Safe::BEGIN@30
111112µs2.87msSafe::::newSafe::new
11193µs93µsSafe::::BEGIN@3Safe::BEGIN@3
11150µs119µsSafe::::BEGIN@191Safe::BEGIN@191
11141µs57µsSafe::::permit_onlySafe::permit_only
11139µs93µsSafe::::BEGIN@36Safe::BEGIN@36
11135µs51µsSafe::::BEGIN@28Safe::BEGIN@28
11134µs85µsSafe::::BEGIN@337Safe::BEGIN@337
11132µs204µsSafe::::BEGIN@4Safe::BEGIN@4
11132µs81µsSafe::::BEGIN@285Safe::BEGIN@285
11132µs32µsSafe::::CORE:packSafe::CORE:pack (opcode)
11131µs44µsSafe::::permitSafe::permit
11131µs418µsSafe::::shareSafe::share
11129µs178µsSafe::::BEGIN@29Safe::BEGIN@29
11126µs26µsSafe::::CORE:matchSafe::CORE:match (opcode)
11125µs60µsSafe::::BEGIN@344Safe::BEGIN@344
11124µs24µsSafe::::BEGIN@35Safe::BEGIN@35
21123µs23µsSafe::::rootSafe::root
11122µs22µsSafe::::BEGIN@70Safe::BEGIN@70
0000s0sSafe::::DESTROYSafe::DESTROY
0000s0sSafe::::__ANON__[:417]Safe::__ANON__[:417]
0000s0sSafe::::__ANON__[:42]Safe::__ANON__[:42]
0000s0sSafe::::__ANON__[:435]Safe::__ANON__[:435]
0000s0sSafe::::_clean_stashSafe::_clean_stash
0000s0sSafe::::_find_code_refsSafe::_find_code_refs
0000s0sSafe::::denySafe::deny
0000s0sSafe::::deny_onlySafe::deny_only
0000s0sSafe::::dump_maskSafe::dump_mask
0000s0sSafe::::eraseSafe::erase
0000s0sSafe::::lexless_anon_subSafe::lexless_anon_sub
0000s0sSafe::::maskSafe::mask
0000s0sSafe::::rdoSafe::rdo
0000s0sSafe::::reinitSafe::reinit
0000s0sSafe::::revalSafe::reval
0000s0sSafe::::share_forgetSafe::share_forget
0000s0sSafe::::share_redoSafe::share_redo
0000s0sSafe::::trapSafe::trap
0000s0sSafe::::untrapSafe::untrap
0000s0sSafe::::varglobSafe::varglob
0000s0sSafe::::wrap_code_refSafe::wrap_code_ref
0000s0sSafe::::wrap_code_refs_withinSafe::wrap_code_refs_within
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
0122µsProfile data that couldn't be associated with a specific line:
# spent 22µs making 1 call to Safe::BEGIN@70
1145µspackage Safe;
2
32206µs193µs
# spent 93µs within Safe::BEGIN@3 which was called: # once (93µs+0s) by Data::DPath::Context::BEGIN@23 at line 3
use 5.003_11;
# spent 93µs making 1 call to Safe::BEGIN@3
42416µs2376µs
# spent 204µs (32+172) within Safe::BEGIN@4 which was called: # once (32µs+172µs) by Data::DPath::Context::BEGIN@23 at line 4
use Scalar::Util qw(reftype refaddr);
# spent 204µs making 1 call to Safe::BEGIN@4 # spent 172µs making 1 call to Exporter::import
5
613µs$Safe::VERSION = "2.33";
7
8# *** Don't declare any lexicals above this point ***
9#
10# This function should return a closure which contains an eval that can't
11# see any lexicals in scope (apart from __ExPr__ which is unavoidable)
12
13sub lexless_anon_sub {
14 # $_[0] is package;
15 # $_[1] is strict flag;
16 my $__ExPr__ = $_[2]; # must be a lexical to create the closure that
17 # can be used to pass the value into the safe
18 # world
19
20 # Create anon sub ref in root of compartment.
21 # Uses a closure (on $__ExPr__) to pass in the code to be executed.
22 # (eval on one line to keep line numbers as expected by caller)
23 eval sprintf
24 'package %s; %s sub { @_=(); eval q[my $__ExPr__;] . $__ExPr__; }',
25 $_[0], $_[1] ? 'use strict;' : '';
26}
27
28292µs266µs
# spent 51µs (35+16) within Safe::BEGIN@28 which was called: # once (35µs+16µs) by Data::DPath::Context::BEGIN@23 at line 28
use strict;
# spent 51µs making 1 call to Safe::BEGIN@28 # spent 16µs making 1 call to strict::import
292100µs2326µs
# spent 178µs (29+148) within Safe::BEGIN@29 which was called: # once (29µs+148µs) by Data::DPath::Context::BEGIN@23 at line 29
use Carp;
# spent 178µs making 1 call to Safe::BEGIN@29 # spent 148µs making 1 call to Exporter::import
301146µs
# spent 630µs (153+476) within Safe::BEGIN@30 which was called: # once (153µs+476µs) by Data::DPath::Context::BEGIN@23 at line 32
BEGIN { eval q{
# spent 341µs executing statements in string eval
# includes 445µs spent executing 1 call to 1 sub defined therein.
31 use Carp::Heavy;
32171µs1630µs} }
# spent 630µs making 1 call to Safe::BEGIN@30
33
342434µs112.4ms
# spent 12.4ms (9.51+2.88) within Safe::BEGIN@34 which was called: # once (9.51ms+2.88ms) by Data::DPath::Context::BEGIN@23 at line 34
use B ();
# spent 12.4ms making 1 call to Safe::BEGIN@34
35
# spent 24µs within Safe::BEGIN@35 which was called: # once (24µs+0s) by Data::DPath::Context::BEGIN@23 at line 44
BEGIN {
362275µs2147µs
# spent 93µs (39+54) within Safe::BEGIN@36 which was called: # once (39µs+54µs) by Data::DPath::Context::BEGIN@23 at line 36
no strict 'refs';
# spent 93µs making 1 call to Safe::BEGIN@36 # spent 54µs making 1 call to strict::unimport
37124µs if (defined &B::sub_generation) {
38 *sub_generation = \&B::sub_generation;
39 }
40 else {
41 # fake sub generation changing for perls < 5.8.9
42 my $sg; *sub_generation = sub { ++$sg };
43 }
441128µs124µs}
# spent 24µs making 1 call to Safe::BEGIN@35
45
4611.06ms
# spent 19.7ms (3.21+16.4) within Safe::BEGIN@46 which was called: # once (3.21ms+16.4ms) by Data::DPath::Context::BEGIN@23 at line 50
use Opcode 1.01, qw(
# spent 1.06ms making 1 call to Exporter::import
47 opset opset_to_ops opmask_add
48 empty_opset full_opset invert_opset verify_opset
49 opdesc opcodes opmask define_optag opset_to_hex
5022.28ms119.7ms);
# spent 19.7ms making 1 call to Safe::BEGIN@46
51
5218µs*ops_to_opset = \&opset; # Temporary alias for old Penguins
53
54# Regular expressions and other unicode-aware code may need to call
55# utf8->SWASHNEW (via perl's utf8.c). That will fail unless we share the
56# SWASHNEW method.
57# Sadly we can't just add utf8::SWASHNEW to $default_share because perl's
58# utf8.c code does a fetchmethod on SWASHNEW to check if utf8.pm is loaded,
59# and sharing makes it look like the method exists.
60# The simplest and most robust fix is to ensure the utf8 module is loaded when
61# Safe is loaded. Then we can add utf8::SWASHNEW to $default_share.
621848µsrequire utf8;
63# we must ensure that utf8_heavy.pl, where SWASHNEW is defined, is loaded
64# but without depending on too much knowledge of that implementation detail.
65# This code (//i on a unicode string) should ensure utf8 is fully loaded
66# and also loads the ToFold SWASH, unless things change so that these
67# particular code points don't cause it to load.
68# (Swashes are cached internally by perl in PL_utf8_* variables
69# independent of being inside/outside of Safe. So once loaded they can be)
707449µs5148ms
# spent 22µs within Safe::BEGIN@70 which was called: # once (22µs+0s) by Safe::CORE:regcomp at line 0
do { my $a = pack('U',0x100); my $b = chr 0x101; utf8::upgrade $b; $a =~ /$b/i };
# spent 136ms making 1 call to Safe::CORE:regcomp # spent 12.0ms making 1 call to utf8::AUTOLOAD # spent 32µs making 1 call to Safe::CORE:pack # spent 26µs making 1 call to Safe::CORE:match # spent 8µs making 1 call to utf8::upgrade
71# now we can safely include utf8::SWASHNEW in $default_share defined below.
72
7313µsmy $default_root = 0;
74# share *_ and functions defined in universal.c
75# Don't share stuff like *UNIVERSAL:: otherwise code from the
76# compartment can 0wn functions in UNIVERSAL
77152µsmy $default_share = [qw[
78 *_
79 &PerlIO::get_layers
80 &UNIVERSAL::isa
81 &UNIVERSAL::can
82 &UNIVERSAL::VERSION
83 &utf8::is_utf8
84 &utf8::valid
85 &utf8::encode
86 &utf8::decode
87 &utf8::upgrade
88 &utf8::downgrade
89 &utf8::native_to_unicode
90 &utf8::unicode_to_native
91 &utf8::SWASHNEW
92 $version::VERSION
93 $version::CLASS
94 $version::STRICT
95 $version::LAX
96 @version::ISA
97], ($] < 5.010 && qw[
98 &utf8::SWASHGET
99]), ($] >= 5.008001 && qw[
100 &Regexp::DESTROY
101]), ($] >= 5.010 && qw[
102 &re::is_regexp
103 &re::regname
104 &re::regnames
105 &re::regnames_count
106 &UNIVERSAL::DOES
107 &version::()
108 &version::new
109 &version::(""
110 &version::stringify
111 &version::(0+
112 &version::numify
113 &version::normal
114 &version::(cmp
115 &version::(<=>
116 &version::vcmp
117 &version::(bool
118 &version::boolean
119 &version::(nomethod
120 &version::noop
121 &version::is_alpha
122 &version::qv
123 &version::vxs::declare
124 &version::vxs::qv
125 &version::vxs::_VERSION
126 &version::vxs::stringify
127 &version::vxs::new
128 &version::vxs::parse
129 &version::vxs::VCMP
130]), ($] >= 5.011 && qw[
131 &re::regexp_pattern
132]), ($] >= 5.010 && $] < 5.014 && qw[
133 &Tie::Hash::NamedCapture::FETCH
134 &Tie::Hash::NamedCapture::STORE
135 &Tie::Hash::NamedCapture::DELETE
136 &Tie::Hash::NamedCapture::CLEAR
137 &Tie::Hash::NamedCapture::EXISTS
138 &Tie::Hash::NamedCapture::FIRSTKEY
139 &Tie::Hash::NamedCapture::NEXTKEY
140 &Tie::Hash::NamedCapture::SCALAR
141 &Tie::Hash::NamedCapture::flags
142])];
14311µsif (defined $Devel::Cover::VERSION) {
144 push @$default_share, '&Devel::Cover::use_file';
145}
146
147
# spent 2.87ms (112µs+2.76) within Safe::new which was called: # once (112µs+2.76ms) by Data::DPath::Context::BEGIN@29 at line 39 of Data/DPath/Context.pm
sub new {
14811135µs my($class, $root, $mask) = @_;
149 my $obj = {};
150 bless $obj, $class;
151
152 if (defined($root)) {
153 croak "Can't use \"$root\" as root name"
154 if $root =~ /^main\b/ or $root !~ /^\w[:\w]*$/;
155 $obj->{Root} = $root;
156 $obj->{Erase} = 0;
157 }
158 else {
159 $obj->{Root} = "Safe::Root".$default_root++;
160 $obj->{Erase} = 1;
161 }
162
163 # use permit/deny methods instead till interface issues resolved
164 # XXX perhaps new Safe 'Root', mask => $mask, foo => bar, ...;
165 croak "Mask parameter to new no longer supported" if defined $mask;
166157µs $obj->permit_only(':default');
# spent 57µs making 1 call to Safe::permit_only
167
168 # We must share $_ and @_ with the compartment or else ops such
169 # as split, length and so on won't default to $_ properly, nor
170 # will passing argument to subroutines work (via @_). In fact,
171 # for reasons I don't completely understand, we need to share
172 # the whole glob *_ rather than $_ and @_ separately, otherwise
173 # @_ in non default packages within the compartment don't work.
17412.67ms $obj->share_from('main', $default_share);
# spent 2.67ms making 1 call to Safe::share_from
175
176127µs Opcode::_safe_pkg_prep($obj->{Root}) if($Opcode::VERSION > 1.04);
# spent 27µs making 1 call to Opcode::_safe_pkg_prep
177
178 return $obj;
179}
180
181sub DESTROY {
182 my $obj = shift;
183 $obj->erase('DESTROY') if $obj->{Erase};
184}
185
186sub erase {
187 my ($obj, $action) = @_;
188 my $pkg = $obj->root();
189 my ($stem, $leaf);
190
19121.95ms2188µs
# spent 119µs (50+69) within Safe::BEGIN@191 which was called: # once (50µs+69µs) by Data::DPath::Context::BEGIN@23 at line 191
no strict 'refs';
# spent 119µs making 1 call to Safe::BEGIN@191 # spent 69µs making 1 call to strict::unimport
192 $pkg = "main::$pkg\::"; # expand to full symbol table name
193 ($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/;
194
195 # The 'my $foo' is needed! Without it you get an
196 # 'Attempt to free unreferenced scalar' warning!
197 my $stem_symtab = *{$stem}{HASH};
198
199 #warn "erase($pkg) stem=$stem, leaf=$leaf";
200 #warn " stem_symtab hash ".scalar(%$stem_symtab)."\n";
201 # ", join(', ', %$stem_symtab),"\n";
202
203# delete $stem_symtab->{$leaf};
204
205 my $leaf_glob = $stem_symtab->{$leaf};
206 my $leaf_symtab = *{$leaf_glob}{HASH};
207# warn " leaf_symtab ", join(', ', %$leaf_symtab),"\n";
208 %$leaf_symtab = ();
209 #delete $leaf_symtab->{'__ANON__'};
210 #delete $leaf_symtab->{'foo'};
211 #delete $leaf_symtab->{'main::'};
212# my $foo = undef ${"$stem\::"}{"$leaf\::"};
213
214 if ($action and $action eq 'DESTROY') {
215 delete $stem_symtab->{$leaf};
216 } else {
217 $obj->share_from('main', $default_share);
218 }
219 1;
220}
221
222
223sub reinit {
224 my $obj= shift;
225 $obj->erase;
226 $obj->share_redo;
227}
228
229
# spent 23µs within Safe::root which was called 2 times, avg 11µs/call: # 2 times (23µs+0s) by Safe::share_from at line 283, avg 11µs/call
sub root {
230636µs my $obj = shift;
231 croak("Safe root method now read-only") if @_;
232 return $obj->{Root};
233}
234
235
236sub mask {
237 my $obj = shift;
238 return $obj->{Mask} unless @_;
239 $obj->deny_only(@_);
240}
241
242# v1 compatibility methods
243sub trap { shift->deny(@_) }
244sub untrap { shift->permit(@_) }
245
246sub deny {
247 my $obj = shift;
248 $obj->{Mask} |= opset(@_);
249}
250sub deny_only {
251 my $obj = shift;
252 $obj->{Mask} = opset(@_);
253}
254
255
# spent 44µs (31+12) within Safe::permit which was called: # once (31µs+12µs) by Data::DPath::Context::BEGIN@29 at line 40 of Data/DPath/Context.pm
sub permit {
256249µs my $obj = shift;
257 # XXX needs testing
258212µs $obj->{Mask} &= invert_opset opset(@_);
# spent 8µs making 1 call to Opcode::opset # spent 5µs making 1 call to Opcode::invert_opset
259}
260
# spent 57µs (41+16) within Safe::permit_only which was called: # once (41µs+16µs) by Safe::new at line 166
sub permit_only {
261262µs my $obj = shift;
262216µs $obj->{Mask} = invert_opset opset(@_);
# spent 10µs making 1 call to Opcode::opset # spent 6µs making 1 call to Opcode::invert_opset
263}
264
265
266sub dump_mask {
267 my $obj = shift;
268 print opset_to_hex($obj->{Mask}),"\n";
269}
270
271
272
# spent 418µs (31+387) within Safe::share which was called: # once (31µs+387µs) by Data::DPath::Context::BEGIN@29 at line 42 of Data/DPath/Context.pm
sub share {
273233µs my($obj, @vars) = @_;
2741386µs $obj->share_from(scalar(caller), \@vars);
# spent 386µs making 1 call to Safe::share_from
275}
276
277
278
# spent 3.06ms (2.61+448µs) within Safe::share_from which was called 2 times, avg 1.53ms/call: # once (2.29ms+382µs) by Safe::new at line 174 # once (320µs+66µs) by Safe::share at line 274
sub share_from {
2793152.87ms my $obj = shift;
280 my $pkg = shift;
281 my $vars = shift;
282 my $no_record = shift || 0;
283223µs my $root = $obj->root();
# spent 23µs making 2 calls to Safe::root, avg 11µs/call
284 croak("vars not an array ref") unless ref $vars eq 'ARRAY';
28521.56ms2129µs
# spent 81µs (32+48) within Safe::BEGIN@285 which was called: # once (32µs+48µs) by Data::DPath::Context::BEGIN@23 at line 285
no strict 'refs';
# spent 81µs making 1 call to Safe::BEGIN@285 # spent 48µs making 1 call to strict::unimport
286 # Check that 'from' package actually exists
287 croak("Package \"$pkg\" does not exist")
288 unless keys %{"$pkg\::"};
289 my $arg;
290 foreach $arg (@$vars) {
291 # catch some $safe->share($var) errors:
292 my ($var, $type);
29359269µs $type = $1 if ($var = $arg) =~ s/^(\W)//;
# spent 269µs making 59 calls to Safe::CORE:subst, avg 5µs/call
294 # warn "share_from $pkg $type $var";
295 for (1..2) { # assign twice to avoid any 'used once' warnings
296 *{$root."::$var"} = (!$type) ? \&{$pkg."::$var"}
297 : ($type eq '&') ? \&{$pkg."::$var"}
298 : ($type eq '$') ? \${$pkg."::$var"}
299 : ($type eq '@') ? \@{$pkg."::$var"}
300 : ($type eq '%') ? \%{$pkg."::$var"}
301 : ($type eq '*') ? *{$pkg."::$var"}
302 : croak(qq(Can't share "$type$var" of unknown type));
303 }
304 }
3052156µs $obj->share_record($pkg, $vars) unless $no_record or !$vars;
# spent 156µs making 2 calls to Safe::share_record, avg 78µs/call
306}
307
308
309
# spent 156µs within Safe::share_record which was called 2 times, avg 78µs/call: # 2 times (156µs+0s) by Safe::share_from at line 305, avg 78µs/call
sub share_record {
31010170µs my $obj = shift;
311 my $pkg = shift;
312 my $vars = shift;
313 my $shares = \%{$obj->{Shares} ||= {}};
314 # Record shares using keys of $obj->{Shares}. See reinit.
315 @{$shares}{@$vars} = ($pkg) x @$vars if @$vars;
316}
317
318
319sub share_redo {
320 my $obj = shift;
321 my $shares = \%{$obj->{Shares} ||= {}};
322 my($var, $pkg);
323 while(($var, $pkg) = each %$shares) {
324 # warn "share_redo $pkg\:: $var";
325 $obj->share_from($pkg, [ $var ], 1);
326 }
327}
328
329
330sub share_forget {
331 delete shift->{Shares};
332}
333
334
335sub varglob {
336 my ($obj, $var) = @_;
3372256µs2135µs
# spent 85µs (34+50) within Safe::BEGIN@337 which was called: # once (34µs+50µs) by Data::DPath::Context::BEGIN@23 at line 337
no strict 'refs';
# spent 85µs making 1 call to Safe::BEGIN@337 # spent 50µs making 1 call to strict::unimport
338 return *{$obj->root()."::$var"};
339}
340
341sub _clean_stash {
342 my ($root, $saved_refs) = @_;
343 $saved_refs ||= [];
34422.67ms294µs
# spent 60µs (25+34) within Safe::BEGIN@344 which was called: # once (25µs+34µs) by Data::DPath::Context::BEGIN@23 at line 344
no strict 'refs';
# spent 60µs making 1 call to Safe::BEGIN@344 # spent 34µs making 1 call to strict::unimport
345 foreach my $hook (qw(DESTROY AUTOLOAD), grep /^\(/, keys %$root) {
346 push @$saved_refs, \*{$root.$hook};
347 delete ${$root}{$hook};
348 }
349
350 for (grep /::$/, keys %$root) {
351 next if \%{$root.$_} eq \%$root;
352 _clean_stash($root.$_, $saved_refs);
353 }
354}
355
356sub reval {
357 my ($obj, $expr, $strict) = @_;
358 my $root = $obj->{Root};
359
360 my $evalsub = lexless_anon_sub($root, $strict, $expr);
361 # propagate context
362 my $sg = sub_generation();
363 my @subret = (wantarray)
364 ? Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub)
365 : scalar Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
366 _clean_stash($root.'::') if $sg != sub_generation();
367 $obj->wrap_code_refs_within(@subret);
368 return (wantarray) ? @subret : $subret[0];
369}
370
37111µsmy %OID;
372
373sub wrap_code_refs_within {
374 my $obj = shift;
375
376 %OID = ();
377 $obj->_find_code_refs('wrap_code_ref', @_);
378}
379
380
381sub _find_code_refs {
382 my $obj = shift;
383 my $visitor = shift;
384
385 for my $item (@_) {
386 my $reftype = $item && reftype $item
387 or next;
388
389 # skip references already seen
390 next if ++$OID{refaddr $item} > 1;
391
392 if ($reftype eq 'ARRAY') {
393 $obj->_find_code_refs($visitor, @$item);
394 }
395 elsif ($reftype eq 'HASH') {
396 $obj->_find_code_refs($visitor, values %$item);
397 }
398 # XXX GLOBs?
399 elsif ($reftype eq 'CODE') {
400 $item = $obj->$visitor($item);
401 }
402 }
403}
404
405
406sub wrap_code_ref {
407 my ($obj, $sub) = @_;
408
409 # wrap code ref $sub with _safe_call_sv so that, when called, the
410 # execution will happen with the compartment fully 'in effect'.
411
412 croak "Not a CODE reference"
413 if reftype $sub ne 'CODE';
414
415 my $ret = sub {
416 my @args = @_; # lexical to close over
417 my $sub_with_args = sub { $sub->(@args) };
418
419 my @subret;
420 my $error;
421 do {
422 local $@; # needed due to perl_call_sv(sv, G_EVAL|G_KEEPERR)
423 my $sg = sub_generation();
424 @subret = (wantarray)
425 ? Opcode::_safe_call_sv($obj->{Root}, $obj->{Mask}, $sub_with_args)
426 : scalar Opcode::_safe_call_sv($obj->{Root}, $obj->{Mask}, $sub_with_args);
427 $error = $@;
428 _clean_stash($obj->{Root}.'::') if $sg != sub_generation();
429 };
430 if ($error) { # rethrow exception
431 $error =~ s/\t\(in cleanup\) //; # prefix added by G_KEEPERR
432 die $error;
433 }
434 return (wantarray) ? @subret : $subret[0];
435 };
436
437 return $ret;
438}
439
440
441sub rdo {
442 my ($obj, $file) = @_;
443 my $root = $obj->{Root};
444
445 my $sg = sub_generation();
446 my $evalsub = eval
447 sprintf('package %s; sub { @_ = (); do $file }', $root);
448 my @subret = (wantarray)
449 ? Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub)
450 : scalar Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
451 _clean_stash($root.'::') if $sg != sub_generation();
452 $obj->wrap_code_refs_within(@subret);
453 return (wantarray) ? @subret : $subret[0];
454}
455
456
457183µs1;
458
459__END__
 
# spent 26µs within Safe::CORE:match which was called: # once (26µs+0s) by Data::DPath::Context::BEGIN@23 at line 70
sub Safe::CORE:match; # opcode
# spent 32µs within Safe::CORE:pack which was called: # once (32µs+0s) by Data::DPath::Context::BEGIN@23 at line 70
sub Safe::CORE:pack; # opcode
# spent 136ms (362µs+136) within Safe::CORE:regcomp which was called: # once (362µs+136ms) by Data::DPath::Context::BEGIN@23 at line 70
sub Safe::CORE:regcomp; # opcode
# spent 269µs within Safe::CORE:subst which was called 59 times, avg 5µs/call: # 59 times (269µs+0s) by Safe::share_from at line 293, avg 5µs/call
sub Safe::CORE:subst; # opcode