Filename | /usr/share/perl/5.10/feature.pm |
Statements | Executed 432 statements in 1.31ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
23 | 21 | 14 | 973µs | 1.21ms | import | feature::
14 | 1 | 1 | 180µs | 180µs | CORE:subst (opcode) | feature::
28 | 1 | 1 | 55µs | 55µs | CORE:substcont (opcode) | feature::
0 | 0 | 0 | 0s | 0s | croak | feature::
0 | 0 | 0 | 0s | 0s | unimport | feature::
0 | 0 | 0 | 0s | 0s | unknown_feature | feature::
0 | 0 | 0 | 0s | 0s | unknown_feature_bundle | feature::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package feature; | ||||
2 | |||||
3 | 1 | 2µs | our $VERSION = '1.13'; | ||
4 | |||||
5 | # (feature name) => (internal name, used in %^H) | ||||
6 | 1 | 6µs | my %feature = ( | ||
7 | switch => 'feature_switch', | ||||
8 | say => "feature_say", | ||||
9 | state => "feature_state", | ||||
10 | ); | ||||
11 | |||||
12 | # NB. the latest bundle must be loaded by the -E switch (see toke.c) | ||||
13 | |||||
14 | 1 | 11µs | my %feature_bundle = ( | ||
15 | "5.10" => [qw(switch say state)], | ||||
16 | ### "5.11" => [qw(switch say state)], | ||||
17 | ); | ||||
18 | |||||
19 | # special case | ||||
20 | 1 | 1µs | $feature_bundle{"5.9.5"} = $feature_bundle{"5.10"}; | ||
21 | |||||
22 | # TODO: | ||||
23 | # - think about versioned features (use feature switch => 2) | ||||
24 | |||||
25 | =head1 NAME | ||||
26 | |||||
- - | |||||
145 | # spent 1.21ms (973µs+235µs) within feature::import which was called 23 times, avg 53µs/call:
# 3 times (109µs+0s) by Modern::Perl::import at line 26 of Modern/Perl.pm, avg 36µs/call
# once (145µs+37µs) by Modern::Perl::BEGIN@15.1 at line 15 of Modern/Perl.pm
# once (80µs+23µs) by Date::Manip::Delta::BEGIN@17 at line 17 of Date/Manip/Delta.pm
# once (67µs+18µs) by Date::Manip::Date::BEGIN@17 at line 17 of Date/Manip/Date.pm
# once (61µs+21µs) by Date::Manip::Base::BEGIN@17 at line 17 of Date/Manip/Base.pm
# once (54µs+21µs) by Date::Manip::Recur::BEGIN@17 at line 17 of Date/Manip/Recur.pm
# once (51µs+18µs) by Date::Manip::BEGIN@11 at line 11 of Date/Manip.pm
# once (47µs+20µs) by Date::Manip::TZ::BEGIN@17 at line 17 of Date/Manip/TZ.pm
# once (46µs+15µs) by Koha::DateUtils::BEGIN@21.9 at line 21 of /usr/share/koha/lib/Koha/DateUtils.pm
# once (45µs+16µs) by Date::Manip::Zones::BEGIN@18 at line 18 of Date/Manip/Zones.pm
# once (46µs+12µs) by Date::Manip::Obj::BEGIN@9 at line 9 of Date/Manip/Obj.pm
# once (44µs+10µs) by Koha::Calendar::BEGIN@4.10 at line 4 of /usr/share/koha/lib/Koha/Calendar.pm
# once (38µs+11µs) by Date::Manip::Lang::english::BEGIN@23 at line 23 of Date/Manip/Lang/english.pm
# once (40µs+8µs) by Date::Manip::TZ::etgmt00::BEGIN@32 at line 32 of Date/Manip/TZ/etgmt00.pm
# once (27µs+7µs) by Date::Manip::Lang::index::BEGIN@22 at line 22 of Date/Manip/Lang/index.pm
# once (15µs+0s) by Date::Manip::Recur::BEGIN@21 at line 21 of Date/Manip/Recur.pm
# once (14µs+0s) by Date::Manip::Delta::BEGIN@21 at line 21 of Date/Manip/Delta.pm
# once (14µs+0s) by Date::Manip::BEGIN@55 at line 55 of Date/Manip.pm
# once (12µs+0s) by Date::Manip::TZ::BEGIN@20 at line 20 of Date/Manip/TZ.pm
# once (9µs+0s) by Date::Manip::Date::BEGIN@22 at line 22 of Date/Manip/Date.pm
# once (9µs+0s) by Date::Manip::Base::BEGIN@22 at line 22 of Date/Manip/Base.pm | ||||
146 | 69 | 235µs | my $class = shift; | ||
147 | if (@_ == 0) { | ||||
148 | croak("No features specified"); | ||||
149 | } | ||||
150 | while (@_) { | ||||
151 | 262 | 361µs | my $name = shift(@_); | ||
152 | 68 | 156µs | if (substr($name, 0, 1) eq ":") { | ||
153 | my $v = substr($name, 1); | ||||
154 | 28 | 532µs | if (!exists $feature_bundle{$v}) { | ||
155 | 42 | 235µs | $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/; # spent 180µs making 14 calls to feature::CORE:subst, avg 13µs/call
# spent 55µs making 28 calls to feature::CORE:substcont, avg 2µs/call | ||
156 | if (!exists $feature_bundle{$v}) { | ||||
157 | unknown_feature_bundle(substr($name, 1)); | ||||
158 | } | ||||
159 | } | ||||
160 | unshift @_, @{$feature_bundle{$v}}; | ||||
161 | next; | ||||
162 | } | ||||
163 | if (!exists $feature{$name}) { | ||||
164 | unknown_feature($name); | ||||
165 | } | ||||
166 | $^H{$feature{$name}} = 1; | ||||
167 | } | ||||
168 | } | ||||
169 | |||||
170 | sub unimport { | ||||
171 | my $class = shift; | ||||
172 | |||||
173 | # A bare C<no feature> should disable *all* features | ||||
174 | if (!@_) { | ||||
175 | delete @^H{ values(%feature) }; | ||||
176 | return; | ||||
177 | } | ||||
178 | |||||
179 | while (@_) { | ||||
180 | my $name = shift; | ||||
181 | if (substr($name, 0, 1) eq ":") { | ||||
182 | my $v = substr($name, 1); | ||||
183 | if (!exists $feature_bundle{$v}) { | ||||
184 | $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/; | ||||
185 | if (!exists $feature_bundle{$v}) { | ||||
186 | unknown_feature_bundle(substr($name, 1)); | ||||
187 | } | ||||
188 | } | ||||
189 | unshift @_, @{$feature_bundle{$v}}; | ||||
190 | next; | ||||
191 | } | ||||
192 | if (!exists($feature{$name})) { | ||||
193 | unknown_feature($name); | ||||
194 | } | ||||
195 | else { | ||||
196 | delete $^H{$feature{$name}}; | ||||
197 | } | ||||
198 | } | ||||
199 | } | ||||
200 | |||||
201 | sub unknown_feature { | ||||
202 | my $feature = shift; | ||||
203 | croak(sprintf('Feature "%s" is not supported by Perl %vd', | ||||
204 | $feature, $^V)); | ||||
205 | } | ||||
206 | |||||
207 | sub unknown_feature_bundle { | ||||
208 | my $feature = shift; | ||||
209 | croak(sprintf('Feature bundle "%s" is not supported by Perl %vd', | ||||
210 | $feature, $^V)); | ||||
211 | } | ||||
212 | |||||
213 | sub croak { | ||||
214 | require Carp; | ||||
215 | Carp::croak(@_); | ||||
216 | } | ||||
217 | |||||
218 | 1 | 11µs | 1; | ||
# spent 180µs within feature::CORE:subst which was called 14 times, avg 13µs/call:
# 14 times (180µs+0s) by feature::import at line 155, avg 13µs/call | |||||
# spent 55µs within feature::CORE:substcont which was called 28 times, avg 2µs/call:
# 28 times (55µs+0s) by feature::import at line 155, avg 2µs/call |