| 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 | Symbol::qualify |
| 5 | 1 | 1 | 35µs | 91µs | Symbol::qualify_to_ref |
| 1 | 1 | 1 | 21µs | 21µs | Symbol::gensym |
| 0 | 0 | 0 | 0s | 0s | Symbol::BEGIN |
| 0 | 0 | 0 | 0s | 0s | Symbol::delete_package |
| 0 | 0 | 0 | 0s | 0s | Symbol::geniosym |
| 0 | 0 | 0 | 0s | 0s | Symbol::ungensym |
| 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; |