| Filename | /usr/share/perl/5.10/feature.pm |
| Statements | Executed 28 statements in 100µs |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 64µs | 81µs | feature::import |
| 1 | 1 | 1 | 8µs | 8µs | feature::CORE:subst (opcode) |
| 2 | 1 | 1 | 8µs | 8µs | feature::CORE:substcont (opcode) |
| 0 | 0 | 0 | 0s | 0s | feature::croak |
| 0 | 0 | 0 | 0s | 0s | feature::unimport |
| 0 | 0 | 0 | 0s | 0s | feature::unknown_feature |
| 0 | 0 | 0 | 0s | 0s | feature::unknown_feature_bundle |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package feature; | ||||
| 2 | |||||
| 3 | 1 | 800ns | our $VERSION = '1.13'; | ||
| 4 | |||||
| 5 | # (feature name) => (internal name, used in %^H) | ||||
| 6 | 1 | 3µ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 | 5µ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 | 800ns | $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 81µs (64+17) within feature::import which was called:
# once (64µs+17µs) by main::BEGIN@3.1 at line 3 of mongo_pain.pl | ||||
| 146 | 1 | 1µs | my $class = shift; | ||
| 147 | 1 | 1µs | if (@_ == 0) { | ||
| 148 | croak("No features specified"); | ||||
| 149 | } | ||||
| 150 | 1 | 5µs | while (@_) { | ||
| 151 | 4 | 2µs | my $name = shift(@_); | ||
| 152 | 4 | 10µs | if (substr($name, 0, 1) eq ":") { | ||
| 153 | 1 | 800ns | my $v = substr($name, 1); | ||
| 154 | 1 | 2µs | if (!exists $feature_bundle{$v}) { | ||
| 155 | 1 | 44µs | 3 | 17µs | $v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/; # spent 8µs making 1 call to feature::CORE:subst
# spent 8µs making 2 calls to feature::CORE:substcont, avg 4µs/call |
| 156 | 1 | 900ns | if (!exists $feature_bundle{$v}) { | ||
| 157 | unknown_feature_bundle(substr($name, 1)); | ||||
| 158 | } | ||||
| 159 | } | ||||
| 160 | 1 | 4µs | unshift @_, @{$feature_bundle{$v}}; | ||
| 161 | 1 | 3µs | next; | ||
| 162 | } | ||||
| 163 | 3 | 900ns | if (!exists $feature{$name}) { | ||
| 164 | unknown_feature($name); | ||||
| 165 | } | ||||
| 166 | 3 | 9µs | $^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 | 7µs | 1; | ||
# spent 8µs within feature::CORE:subst which was called:
# once (8µs+0s) by feature::import at line 155 | |||||
# spent 8µs within feature::CORE:substcont which was called 2 times, avg 4µs/call:
# 2 times (8µs+0s) by feature::import at line 155, avg 4µs/call |