Commit | Line | Data |
---|---|---|
de84ff2b RS |
1 | package experimental; |
2 | $experimental::VERSION = '0.007'; | |
3 | use strict; | |
4 | use warnings; | |
5 | ||
6 | use feature (); | |
7 | use Carp qw/croak carp/; | |
8 | ||
9 | my %warnings = map { $_ => 1 } grep { /^experimental::/ } keys %warnings::Offsets; | |
10 | my %features = map { $_ => 1 } keys %feature::feature; | |
11 | ||
12 | my %min_version = ( | |
13 | array_base => 5, | |
14 | autoderef => 5.014000, | |
15 | lexical_topic => 5.010000, | |
16 | regex_sets => 5.018000, | |
17 | smartmatch => 5.010001, | |
18 | signatures => 5.019009, # change to 5.20.0 someday? -- rjbs, 2014-02-08 | |
19 | ); | |
20 | ||
21 | my %additional = ( | |
22 | postderef => ['postderef_qq'], | |
23 | switch => ['smartmatch'], | |
24 | ); | |
25 | ||
26 | sub _enable { | |
27 | my $pragma = shift; | |
28 | if ($warnings{"experimental::$pragma"}) { | |
29 | warnings->unimport("experimental::$pragma"); | |
30 | feature->import($pragma) if exists $features{$pragma}; | |
31 | _enable(@{ $additional{$pragma} }) if $additional{$pragma}; | |
32 | } | |
33 | elsif ($features{$pragma}) { | |
34 | feature->import($pragma); | |
35 | _enable(@{ $additional{$pragma} }) if $additional{$pragma}; | |
36 | } | |
37 | elsif (not exists $min_version{$pragma}) { | |
38 | croak "Can't enable unknown feature $pragma"; | |
39 | } | |
40 | elsif ($min_version{$pragma} > $]) { | |
41 | croak "Need perl version $min_version{$pragma} or later for feature $pragma"; | |
42 | } | |
43 | } | |
44 | ||
45 | sub import { | |
46 | my ($self, @pragmas) = @_; | |
47 | ||
48 | for my $pragma (@pragmas) { | |
49 | _enable($pragma); | |
50 | } | |
51 | return; | |
52 | } | |
53 | ||
54 | sub _disable { | |
55 | my $pragma = shift; | |
56 | if ($warnings{"experimental::$pragma"}) { | |
57 | warnings->import("experimental::$pragma"); | |
58 | feature->unimport($pragma) if exists $features{$pragma}; | |
59 | _disable(@{ $additional{$pragma} }) if $additional{$pragma}; | |
60 | } | |
61 | elsif ($features{$pragma}) { | |
62 | feature->unimport($pragma); | |
63 | _disable(@{ $additional{$pragma} }) if $additional{$pragma}; | |
64 | } | |
65 | elsif (not exists $min_version{$pragma}) { | |
66 | carp "Can't disable unknown feature $pragma, ignoring"; | |
67 | } | |
68 | } | |
69 | ||
70 | sub unimport { | |
71 | my ($self, @pragmas) = @_; | |
72 | ||
73 | for my $pragma (@pragmas) { | |
74 | _disable($pragma); | |
75 | } | |
76 | return; | |
77 | } | |
78 | ||
79 | 1; | |
80 | ||
81 | #ABSTRACT: Experimental features made easy | |
82 | ||
83 | __END__ | |
84 | ||
85 | =pod | |
86 | ||
87 | =encoding UTF-8 | |
88 | ||
89 | =head1 NAME | |
90 | ||
91 | experimental - Experimental features made easy | |
92 | ||
93 | =head1 VERSION | |
94 | ||
95 | version 0.007 | |
96 | ||
97 | =head1 SYNOPSIS | |
98 | ||
99 | use experimental 'lexical_subs', 'smartmatch'; | |
100 | my sub foo { $_[0] ~~ 1 } | |
101 | ||
102 | =head1 DESCRIPTION | |
103 | ||
104 | This pragma provides an easy and convenient way to enable or disable | |
105 | experimental features. | |
106 | ||
107 | Every version of perl has some number of features present but considered | |
108 | "experimental." For much of the life of Perl 5, this was only a designation | |
109 | found in the documentation. Starting in Perl v5.10.0, and more aggressively in | |
110 | v5.18.0, experimental features were placed behind pragmata used to enable the | |
111 | feature and disable associated warnings. | |
112 | ||
113 | The C<experimental> pragma exists to combine the required incantations into a | |
114 | single interface stable across releases of perl. For every experimental | |
115 | feature, this should enable the feature and silence warnings for the enclosing | |
116 | lexical scope: | |
117 | ||
118 | use experimental 'feature-name'; | |
119 | ||
120 | To disable the feature and, if applicable, re-enable any warnings, use: | |
121 | ||
122 | no experimental 'feature-name'; | |
123 | ||
124 | The supported features, documented further below, are: | |
125 | ||
126 | array_base - allow the use of $[ to change the starting index of @array | |
127 | autoderef - allow push, each, keys, and other built-ins on references | |
128 | lexical_topic - allow the use of lexical $_ via "my $_" | |
129 | postderef - allow the use of postfix dereferencing expressions, including | |
130 | in interpolating strings | |
131 | regex_sets - allow extended bracketed character classes in regexps | |
132 | signatures - allow subroutine signatures (for named arguments) | |
133 | smartmatch - allow the use of ~~, given, and when | |
134 | ||
135 | =head2 Disclaimer | |
136 | ||
137 | Because of the nature of the features it enables, forward compatibility can not | |
138 | be guaranteed in any way. | |
139 | ||
140 | =head1 AUTHOR | |
141 | ||
142 | Leon Timmermans <leont@cpan.org> | |
143 | ||
144 | =head1 COPYRIGHT AND LICENSE | |
145 | ||
146 | This software is copyright (c) 2013 by Leon Timmermans. | |
147 | ||
148 | This is free software; you can redistribute it and/or modify it under | |
149 | the same terms as the Perl 5 programming language system itself. | |
150 | ||
151 | =cut |