File | /usr/share/perl/5.10/Symbol.pm |
Statements Executed | 54 |
Total Time | 0.0007736 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
5 | 1 | 1 | 56µs | 56µs | qualify | Symbol::
5 | 1 | 1 | 35µs | 91µs | qualify_to_ref | Symbol::
1 | 1 | 1 | 21µs | 21µs | gensym | Symbol::
0 | 0 | 0 | 0s | 0s | BEGIN | Symbol::
0 | 0 | 0 | 0s | 0s | delete_package | Symbol::
0 | 0 | 0 | 0s | 0s | geniosym | Symbol::
0 | 0 | 0 | 0s | 0s | ungensym | Symbol::
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | package Symbol; | |||
2 | ||||
3 | 1 | 654µs | 654µs | BEGIN { require 5.005; } |
4 | ||||
5 | 1 | 1µs | 1µs | require Exporter; |
6 | 1 | 7µs | 7µs | @ISA = qw(Exporter); |
7 | 1 | 1µs | 1µs | @EXPORT = qw(gensym ungensym qualify qualify_to_ref); |
8 | 1 | 800ns | 800ns | @EXPORT_OK = qw(delete_package geniosym); |
9 | ||||
10 | 1 | 500ns | 500ns | $VERSION = '1.06'; |
11 | ||||
12 | 1 | 600ns | 600ns | my $genpkg = "Symbol::"; |
13 | 1 | 300ns | 300ns | my $genseq = 0; |
14 | ||||
15 | 1 | 14µs | 14µs | my %global = map {$_ => 1} qw(ARGV ARGVOUT ENV INC SIG STDERR STDIN STDOUT); |
16 | ||||
17 | # | |||
18 | # Note that we never _copy_ the glob; we just make a ref to it. | |||
19 | # If we did copy it, then SVf_FAKE would be set on the copy, and | |||
20 | # glob-specific behaviors (e.g. C<*$ref = \&func>) wouldn't work. | |||
21 | # | |||
22 | # spent 21µs within Symbol::gensym which was called
# once (21µs+0s) by XML::SAX::load_parsers at line 60 of /usr/share/perl5/XML/SAX.pm | |||
23 | 1 | 3µs | 3µs | my $name = "GEN" . $genseq++; |
24 | 1 | 5µs | 5µs | my $ref = \*{$genpkg . $name}; |
25 | 1 | 2µs | 2µs | delete $$genpkg{$name}; |
26 | 1 | 1µs | 1µs | $ref; |
27 | } | |||
28 | ||||
29 | sub geniosym () { | |||
30 | my $sym = gensym(); | |||
31 | # force the IO slot to be filled | |||
32 | select(select $sym); | |||
33 | *$sym{IO}; | |||
34 | } | |||
35 | ||||
36 | sub ungensym ($) {} | |||
37 | ||||
38 | # spent 56µs within Symbol::qualify which was called 5 times, avg 11µs/call:
# 5 times (56µs+0s) by Symbol::qualify_to_ref at line 57, avg 11µs/call | |||
39 | 5 | 8µs | 2µs | my ($name) = @_; |
40 | 5 | 6µs | 1µs | if (!ref($name) && index($name, '::') == -1 && index($name, "'") == -1) { |
41 | 5 | 900ns | 180ns | my $pkg; |
42 | # Global names: special character, "^xyz", or other. | |||
43 | 5 | 13µs | 3µs | if ($name =~ /^(([^a-z])|(\^[a-z_]+))\z/i || $global{$name}) { |
44 | # RGS 2001-11-05 : translate leading ^X to control-char | |||
45 | $name =~ s/^\^([a-z_])/'qq(\c'.$1.')'/eei; | |||
46 | $pkg = "main"; | |||
47 | } | |||
48 | else { | |||
49 | 5 | 4µs | 840ns | $pkg = (@_ > 1) ? $_[1] : caller; |
50 | } | |||
51 | 5 | 7µs | 1µs | $name = $pkg . "::" . $name; |
52 | } | |||
53 | 5 | 6µs | 1µs | $name; |
54 | } | |||
55 | ||||
56 | # spent 91µs (35+56) within Symbol::qualify_to_ref which was called 5 times, avg 18µs/call:
# 5 times (35µs+56µs) by namespace::clean::get_functions at line 308 of /usr/local/share/perl/5.10.0/namespace/clean.pm, avg 18µs/call | |||
57 | 5 | 27µs | 5µs | return \*{ qualify $_[0], @_ > 1 ? $_[1] : caller }; # spent 56µs making 5 calls to Symbol::qualify, avg 11µs/call |
58 | } | |||
59 | ||||
60 | # | |||
61 | # of Safe.pm lineage | |||
62 | # | |||
63 | sub delete_package ($) { | |||
64 | my $pkg = shift; | |||
65 | ||||
66 | # expand to full symbol table name if needed | |||
67 | ||||
68 | unless ($pkg =~ /^main::.*::$/) { | |||
69 | $pkg = "main$pkg" if $pkg =~ /^::/; | |||
70 | $pkg = "main::$pkg" unless $pkg =~ /^main::/; | |||
71 | $pkg .= '::' unless $pkg =~ /::$/; | |||
72 | } | |||
73 | ||||
74 | my($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/; | |||
75 | my $stem_symtab = *{$stem}{HASH}; | |||
76 | return unless defined $stem_symtab and exists $stem_symtab->{$leaf}; | |||
77 | ||||
78 | # free all the symbols in the package | |||
79 | ||||
80 | my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH}; | |||
81 | foreach my $name (keys %$leaf_symtab) { | |||
82 | undef *{$pkg . $name}; | |||
83 | } | |||
84 | ||||
85 | # delete the symbol table | |||
86 | ||||
87 | %$leaf_symtab = (); | |||
88 | delete $stem_symtab->{$leaf}; | |||
89 | } | |||
90 | ||||
91 | 1 | 10µs | 10µs | 1; |