File | /usr/share/perl/5.10/constant.pm |
Statements Executed | 2186 |
Total Time | 0.00425869999999997 seconds |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
94 | 94 | 8 | 3.46ms | 3.98ms | import | constant::
0 | 0 | 0 | 0s | 0s | BEGIN | constant::
0 | 0 | 0 | 0s | 0s | __ANON__[:115] | constant::
0 | 0 | 0 | 0s | 0s | __ANON__[:119] | constant::
0 | 0 | 0 | 0s | 0s | __ANON__[:121] | constant::
Line | Stmts. | Exclusive Time | Avg. | Code |
---|---|---|---|---|
1 | package constant; | |||
2 | 3 | 39µs | 13µs | use 5.005; |
3 | 3 | 28µs | 9µs | use strict; # spent 11µs making 1 call to strict::import |
4 | 3 | 36µs | 12µs | use warnings::register; # spent 96µs making 1 call to warnings::register::import |
5 | ||||
6 | 3 | 165µs | 55µs | use vars qw($VERSION %declared); # spent 35µs making 1 call to vars::import |
7 | 1 | 700ns | 700ns | $VERSION = '1.13'; |
8 | ||||
9 | #======================================================================= | |||
10 | ||||
11 | # Some names are evil choices. | |||
12 | 1 | 18µs | 18µs | my %keywords = map +($_, 1), qw{ BEGIN INIT CHECK END DESTROY AUTOLOAD }; |
13 | 1 | 7µs | 7µs | $keywords{UNITCHECK}++ if $] > 5.009; |
14 | ||||
15 | 1 | 10µs | 10µs | my %forced_into_main = map +($_, 1), |
16 | qw{ STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG }; | |||
17 | ||||
18 | 1 | 8µs | 8µs | my %forbidden = (%keywords, %forced_into_main); |
19 | ||||
20 | #======================================================================= | |||
21 | # import() - import symbols into user's namespace | |||
22 | # | |||
23 | # What we actually do is define a function in the caller's namespace | |||
24 | # which returns the value. The function we create will normally | |||
25 | # be inlined as a constant, thereby avoiding further sub calling | |||
26 | # overhead. | |||
27 | #======================================================================= | |||
28 | # spent 3.98ms (3.46+520µs) within constant::import which was called 94 times, avg 42µs/call:
# once (63µs+18µs) at line 12 of /usr/share/perl5/YAML.pm
# once (51µs+10µs) at line 181 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (48µs+10µs) at line 22 of /usr/share/perl5/MARC/Charset/Constants.pm
# once (50µs+5µs) at line 209 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (44µs+10µs) at line 140 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (45µs+9µs) at line 14 of /usr/local/lib/perl/5.10.0/Class/MOP/Method/Meta.pm
# once (43µs+9µs) at line 7 of /usr/share/perl5/MARC/Field.pm
# once (46µs+5µs) at line 200 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (44µs+6µs) at line 24 of /usr/share/perl5/MARC/Charset/Constants.pm
# once (45µs+5µs) at line 46 of /usr/share/perl5/MARC/Charset/Constants.pm
# once (42µs+8µs) at line 20 of /usr/share/perl5/XML/SAX.pm
# once (43µs+5µs) at line 170 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (40µs+8µs) at line 14 of /usr/lib/perl5/XML/LibXML.pm
# once (43µs+5µs) at line 26 of /usr/share/perl5/MARC/Charset/Constants.pm
# once (36µs+12µs) by MARC::Record::BEGIN at line 34 of /usr/share/perl5/MARC/Record.pm
# once (42µs+5µs) at line 177 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (42µs+5µs) at line 172 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (41µs+5µs) at line 198 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (40µs+5µs) at line 15 of /usr/lib/perl5/XML/LibXML.pm
# once (40µs+5µs) at line 146 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (39µs+5µs) at line 153 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (39µs+5µs) at line 182 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (38µs+5µs) at line 152 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (38µs+5µs) at line 44 of /usr/share/perl5/MARC/Charset/Constants.pm
# once (38µs+5µs) at line 149 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (38µs+5µs) at line 174 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (38µs+5µs) at line 30 of /usr/share/perl5/MARC/Charset/Constants.pm
# once (38µs+5µs) at line 184 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (38µs+5µs) at line 185 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (38µs+5µs) at line 144 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (38µs+5µs) at line 186 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (38µs+5µs) at line 175 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (38µs+5µs) at line 179 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (37µs+5µs) at line 142 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (37µs+5µs) at line 37 of /usr/share/perl5/MARC/Charset/Constants.pm
# once (37µs+5µs) at line 204 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (38µs+5µs) at line 147 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (37µs+5µs) at line 203 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (37µs+5µs) at line 155 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (37µs+5µs) at line 208 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (37µs+5µs) at line 195 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (37µs+5µs) by XML::LibXML::Common::BEGIN at line 213 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (37µs+5µs) at line 40 of /usr/share/perl5/MARC/Charset/Constants.pm
# once (37µs+5µs) at line 143 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (37µs+5µs) at line 45 of /usr/share/perl5/MARC/Charset/Constants.pm
# once (37µs+5µs) at line 199 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (37µs+5µs) at line 165 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (37µs+5µs) at line 205 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (32µs+10µs) at line 145 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (37µs+5µs) at line 206 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (37µs+5µs) at line 212 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (37µs+5µs) at line 176 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (37µs+5µs) at line 34 of /usr/share/perl5/MARC/Charset/Constants.pm
# once (36µs+5µs) at line 36 of /usr/share/perl5/MARC/Charset/Constants.pm
# once (33µs+8µs) at line 8 of /usr/share/perl5/MARC/Field.pm
# once (36µs+5µs) at line 180 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (36µs+5µs) at line 188 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (36µs+5µs) at line 187 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (36µs+5µs) at line 148 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (36µs+5µs) at line 42 of /usr/share/perl5/MARC/Charset/Constants.pm
# once (36µs+5µs) at line 202 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (36µs+5µs) at line 154 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (35µs+5µs) at line 25 of /usr/share/perl5/MARC/Charset/Constants.pm
# once (35µs+5µs) at line 173 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (35µs+5µs) at line 31 of /usr/share/perl5/MARC/Charset/Constants.pm
# once (34µs+5µs) at line 150 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (34µs+5µs) at line 39 of /usr/share/perl5/MARC/Charset/Constants.pm
# once (34µs+5µs) by XML::SAX::BEGIN at line 23 of /usr/share/perl5/XML/SAX.pm
# once (34µs+5µs) at line 32 of /usr/share/perl5/MARC/Charset/Constants.pm
# once (34µs+5µs) at line 27 of /usr/share/perl5/MARC/Charset/Constants.pm
# once (33µs+5µs) at line 141 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (33µs+5µs) at line 171 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (33µs+5µs) at line 201 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (33µs+5µs) at line 183 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (33µs+5µs) at line 151 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (33µs+5µs) at line 35 of /usr/share/perl5/MARC/Charset/Constants.pm
# once (33µs+5µs) at line 210 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (33µs+5µs) by MARC::Charset::Constants::BEGIN at line 47 of /usr/share/perl5/MARC/Charset/Constants.pm
# once (33µs+5µs) at line 194 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (33µs+5µs) at line 207 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (32µs+5µs) at line 29 of /usr/share/perl5/MARC/Charset/Constants.pm
# once (32µs+5µs) at line 163 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (32µs+5µs) at line 189 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (32µs+5µs) at line 196 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (32µs+5µs) at line 178 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (32µs+5µs) at line 162 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (30µs+5µs) at line 22 of /usr/share/perl5/XML/SAX.pm
# once (30µs+5µs) at line 156 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (28µs+5µs) at line 197 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (27µs+5µs) at line 43 of /usr/share/perl5/MARC/Charset/Constants.pm
# once (27µs+5µs) at line 211 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (27µs+5µs) at line 164 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (24µs+5µs) at line 157 of /usr/lib/perl5/XML/LibXML/Common.pm
# once (23µs+5µs) at line 41 of /usr/share/perl5/MARC/Charset/Constants.pm | |||
29 | 2162 | 3.29ms | 2µs | my $class = shift; |
30 | return unless @_; # Ignore 'use constant;' | |||
31 | my $constants; | |||
32 | my $multiple = ref $_[0]; | |||
33 | my $pkg = caller; | |||
34 | my $symtab; | |||
35 | my $str_end = $] >= 5.006 ? "\\z" : "\\Z"; | |||
36 | ||||
37 | if ($] > 5.009002) { | |||
38 | 3 | 353µs | 118µs | no strict 'refs'; # spent 24µs making 1 call to strict::unimport |
39 | $symtab = \%{$pkg . '::'}; | |||
40 | }; | |||
41 | ||||
42 | if ( $multiple ) { | |||
43 | if (ref $_[0] ne 'HASH') { | |||
44 | require Carp; | |||
45 | Carp::croak("Invalid reference type '".ref(shift)."' not 'HASH'"); | |||
46 | } | |||
47 | $constants = shift; | |||
48 | } else { | |||
49 | $constants->{+shift} = undef; | |||
50 | } | |||
51 | ||||
52 | foreach my $name ( keys %$constants ) { | |||
53 | unless (defined $name) { | |||
54 | require Carp; | |||
55 | Carp::croak("Can't use undef as constant name"); | |||
56 | } | |||
57 | ||||
58 | # Normal constant name | |||
59 | if ($name =~ /^_?[^\W_0-9]\w*$str_end/ and !$forbidden{$name}) { | |||
60 | # Everything is okay | |||
61 | ||||
62 | # Name forced into main, but we're not in main. Fatal. | |||
63 | } elsif ($forced_into_main{$name} and $pkg ne 'main') { | |||
64 | require Carp; | |||
65 | Carp::croak("Constant name '$name' is forced into main::"); | |||
66 | ||||
67 | # Starts with double underscore. Fatal. | |||
68 | } elsif ($name =~ /^__/) { | |||
69 | require Carp; | |||
70 | Carp::croak("Constant name '$name' begins with '__'"); | |||
71 | ||||
72 | # Maybe the name is tolerable | |||
73 | } elsif ($name =~ /^[A-Za-z_]\w*$str_end/) { | |||
74 | # Then we'll warn only if you've asked for warnings | |||
75 | if (warnings::enabled()) { | |||
76 | if ($keywords{$name}) { | |||
77 | warnings::warn("Constant name '$name' is a Perl keyword"); | |||
78 | } elsif ($forced_into_main{$name}) { | |||
79 | warnings::warn("Constant name '$name' is " . | |||
80 | "forced into package main::"); | |||
81 | } | |||
82 | } | |||
83 | ||||
84 | # Looks like a boolean | |||
85 | # use constant FRED == fred; | |||
86 | } elsif ($name =~ /^[01]?$str_end/) { | |||
87 | require Carp; | |||
88 | if (@_) { | |||
89 | Carp::croak("Constant name '$name' is invalid"); | |||
90 | } else { | |||
91 | Carp::croak("Constant name looks like boolean value"); | |||
92 | } | |||
93 | ||||
94 | } else { | |||
95 | # Must have bad characters | |||
96 | require Carp; | |||
97 | Carp::croak("Constant name '$name' has invalid characters"); | |||
98 | } | |||
99 | ||||
100 | { | |||
101 | 3 | 292µs | 97µs | no strict 'refs'; # spent 20µs making 1 call to strict::unimport |
102 | my $full_name = "${pkg}::$name"; | |||
103 | $declared{$full_name}++; | |||
104 | if ($multiple || @_ == 1) { | |||
105 | my $scalar = $multiple ? $constants->{$name} : $_[0]; | |||
106 | if ($symtab && !exists $symtab->{$name}) { | |||
107 | # No typeglob yet, so we can use a reference as space- | |||
108 | # efficient proxy for a constant subroutine | |||
109 | # The check in Perl_ck_rvconst knows that inlinable | |||
110 | # constants from cv_const_sv are read only. So we have to: | |||
111 | Internals::SvREADONLY($scalar, 1); # spent 257µs making 94 calls to Internals::SvREADONLY, avg 3µs/call | |||
112 | $symtab->{$name} = \$scalar; | |||
113 | mro::method_changed_in($pkg); # spent 263µs making 94 calls to mro::method_changed_in, avg 3µs/call | |||
114 | } else { | |||
115 | *$full_name = sub () { $scalar }; | |||
116 | } | |||
117 | } elsif (@_) { | |||
118 | my @list = @_; | |||
119 | *$full_name = sub () { @list }; | |||
120 | } else { | |||
121 | *$full_name = sub () { }; | |||
122 | } | |||
123 | } | |||
124 | } | |||
125 | } | |||
126 | ||||
127 | 1 | 15µs | 15µs | 1; |
128 | ||||
129 | __END__ | |||
130 |