/usr/share/perl/5.26.1/feature.pm is in perl-modules-5.26 5.26.1-6ubuntu0.3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 | # -*- buffer-read-only: t -*-
# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
# This file is built by regen/feature.pl.
# Any changes made here will be lost!
package feature;
our $VERSION = '1.47';
our %feature = (
fc => 'feature_fc',
say => 'feature_say',
state => 'feature_state',
switch => 'feature_switch',
bitwise => 'feature_bitwise',
evalbytes => 'feature_evalbytes',
array_base => 'feature_arybase',
signatures => 'feature_signatures',
current_sub => 'feature___SUB__',
refaliasing => 'feature_refaliasing',
postderef_qq => 'feature_postderef_qq',
unicode_eval => 'feature_unieval',
declared_refs => 'feature_myref',
unicode_strings => 'feature_unicode',
);
our %feature_bundle = (
"5.10" => [qw(array_base say state switch)],
"5.11" => [qw(array_base say state switch unicode_strings)],
"5.15" => [qw(current_sub evalbytes fc say state switch unicode_eval unicode_strings)],
"5.23" => [qw(current_sub evalbytes fc postderef_qq say state switch unicode_eval unicode_strings)],
"all" => [qw(array_base bitwise current_sub declared_refs evalbytes fc postderef_qq refaliasing say signatures state switch unicode_eval unicode_strings)],
"default" => [qw(array_base)],
);
$feature_bundle{"5.12"} = $feature_bundle{"5.11"};
$feature_bundle{"5.13"} = $feature_bundle{"5.11"};
$feature_bundle{"5.14"} = $feature_bundle{"5.11"};
$feature_bundle{"5.16"} = $feature_bundle{"5.15"};
$feature_bundle{"5.17"} = $feature_bundle{"5.15"};
$feature_bundle{"5.18"} = $feature_bundle{"5.15"};
$feature_bundle{"5.19"} = $feature_bundle{"5.15"};
$feature_bundle{"5.20"} = $feature_bundle{"5.15"};
$feature_bundle{"5.21"} = $feature_bundle{"5.15"};
$feature_bundle{"5.22"} = $feature_bundle{"5.15"};
$feature_bundle{"5.24"} = $feature_bundle{"5.23"};
$feature_bundle{"5.25"} = $feature_bundle{"5.23"};
$feature_bundle{"5.26"} = $feature_bundle{"5.23"};
$feature_bundle{"5.9.5"} = $feature_bundle{"5.10"};
my %noops = (
postderef => 1,
lexical_subs => 1,
);
our $hint_shift = 26;
our $hint_mask = 0x1c000000;
our @hint_bundles = qw( default 5.10 5.11 5.15 5.23 );
# This gets set (for now) in $^H as well as in %^H,
# for runtime speed of the uc/lc/ucfirst/lcfirst functions.
# See HINT_UNI_8_BIT in perl.h.
our $hint_uni8bit = 0x00000800;
# TODO:
# - think about versioned features (use feature switch => 2)
sub import {
shift;
if (!@_) {
croak("No features specified");
}
__common(1, @_);
}
sub unimport {
shift;
# A bare C<no feature> should reset to the default bundle
if (!@_) {
$^H &= ~($hint_uni8bit|$hint_mask);
return;
}
__common(0, @_);
}
sub __common {
my $import = shift;
my $bundle_number = $^H & $hint_mask;
my $features = $bundle_number != $hint_mask
&& $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]};
if ($features) {
# Features are enabled implicitly via bundle hints.
# Delete any keys that may be left over from last time.
delete @^H{ values(%feature) };
$^H |= $hint_mask;
for (@$features) {
$^H{$feature{$_}} = 1;
$^H |= $hint_uni8bit if $_ eq 'unicode_strings';
}
}
while (@_) {
my $name = shift;
if (substr($name, 0, 1) eq ":") {
my $v = substr($name, 1);
if (!exists $feature_bundle{$v}) {
$v =~ s/^([0-9]+)\.([0-9]+).[0-9]+$/$1.$2/;
if (!exists $feature_bundle{$v}) {
unknown_feature_bundle(substr($name, 1));
}
}
unshift @_, @{$feature_bundle{$v}};
next;
}
if (!exists $feature{$name}) {
if (exists $noops{$name}) {
next;
}
unknown_feature($name);
}
if ($import) {
$^H{$feature{$name}} = 1;
$^H |= $hint_uni8bit if $name eq 'unicode_strings';
} else {
delete $^H{$feature{$name}};
$^H &= ~ $hint_uni8bit if $name eq 'unicode_strings';
}
}
}
sub unknown_feature {
my $feature = shift;
croak(sprintf('Feature "%s" is not supported by Perl %vd',
$feature, $^V));
}
sub unknown_feature_bundle {
my $feature = shift;
croak(sprintf('Feature bundle "%s" is not supported by Perl %vd',
$feature, $^V));
}
sub croak {
require Carp;
Carp::croak(@_);
}
1;
# ex: set ro:
|