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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
package feature;
our $VERSION = '1.10';
# (feature name) => (internal name, used in %^H)
my %feature = (
switch => 'feature_switch',
say => "feature_say",
err => "feature_err",
state => "feature_state",
);
my %feature_bundle = (
"5.10.0" => [qw(switch say err state)],
);
# latest version here
# keep it harcoded until we actually bump the version number to 5.10
$feature_bundle{"5.10"} = $feature_bundle{"5.10.0"};
#$feature_bundle{"5.10"} = $feature_bundle{sprintf("%vd",$^V)};
# TODO:
# - think about versioned features (use feature switch => 2)
=head1 NAME
feature - Perl pragma to enable new syntactic features
=head1 SYNOPSIS
use feature qw(switch say);
given ($foo) {
when (1) { say "\$foo == 1" }
when ([2,3]) { say "\$foo == 2 || \$foo == 3" }
when (/^a[bc]d$/) { say "\$foo eq 'abd' || \$foo eq 'acd'" }
when ($_ > 100) { say "\$foo > 100" }
default { say "None of the above" }
}
use feature ':5.10'; # loads all features available in perl 5.10
=head1 DESCRIPTION
It is usually impossible to add new syntax to Perl without breaking
some existing programs. This pragma provides a way to minimize that
risk. New syntactic constructs can be enabled by C<use feature 'foo'>,
and will be parsed only when the appropriate feature pragma is in
scope.
=head2 Lexical effect
Like other pragmas (C<use strict>, for example), features have a lexical
effect. C<use feature qw(foo)> will only make the feature "foo" available
from that point to the end of the enclosing block.
{
use feature 'say';
say "say is available here";
}
print "But not here.\n";
=head2 C<no feature>
Features can also be turned off by using C<no feature "foo">. This too
has lexical effect.
use feature 'say';
say "say is available here";
{
no feature 'say';
print "But not here.\n";
}
say "Yet it is here.";
C<no feature> with no features specified will turn off all features.
=head2 The 'switch' feature
C<use feature 'switch'> tells the compiler to enable the Perl 6
given/when construct.
See L<perlsyn/"Switch statements"> for details.
=head2 The 'say' feature
C<use feature 'say'> tells the compiler to enable the Perl 6
C<say> function.
See L<perlfunc/say> for details.
=head2 the 'err' feature
C<use feature 'err'> tells the compiler to enable the C<err>
operator.
C<err> is a low-precedence variant of the C<//> operator:
see C<perlop> for details.
=head2 the 'state' feature
C<use feature 'state'> tells the compiler to enable C<state>
variables.
See L<perlsub/"Persistent Private Variables"> for details.
=head1 FEATURE BUNDLES
It's possible to load a whole slew of features in one go, using
a I<feature bundle>. The name of a feature bundle is prefixed with
a colon, to distinguish it from an actual feature. At present, the
only feature bundles are C<use feature ":5.10"> and C<use feature ":5.10.0">,
which both are equivalent to C<use feature qw(switch say err state)>.
In the forthcoming 5.10.X perl releases, C<use feature ":5.10"> will be
equivalent to the latest C<use feature ":5.10.X">.
=cut
sub import {
my $class = shift;
if (@_ == 0) {
croak("No features specified");
}
while (@_) {
my $name = shift(@_);
if ($name =~ /^:(.*)/) {
if (!exists $feature_bundle{$1}) {
unknown_feature_bundle($1);
}
unshift @_, @{$feature_bundle{$1}};
next;
}
if (!exists $feature{$name}) {
unknown_feature($name);
}
$^H{$feature{$name}} = 1;
}
}
sub unimport {
my $class = shift;
# A bare C<no feature> should disable *all* features
if (!@_) {
delete @^H{ values(%feature) };
return;
}
while (@_) {
my $name = shift;
if ($name =~ /^:(.*)/) {
if (!exists $feature_bundle{$1}) {
unknown_feature_bundle($1);
}
unshift @_, @{$feature_bundle{$1}};
next;
}
if (!exists($feature{$name})) {
unknown_feature($name);
}
else {
delete $^H{$feature{$name}};
}
}
}
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;
|
