package experimental;
$experimental::VERSION = '0.022';
use strict;
use warnings;
use version ();
BEGIN { eval { require feature } };
use Carp qw/croak carp/;
my %warnings = map { $_ => 1 } grep { /^experimental::/ } keys %warnings::Offsets;
my %features = map { $_ => 1 } $] > 5.015006 ? keys %feature::feature : do {
my @features;
if ($] >= 5.010) {
push @features, qw/switch say state/;
push @features, 'unicode_strings' if $] > 5.011002;
}
@features;
};
my %min_version = (
array_base => '5',
autoderef => '5.14.0',
bitwise => '5.22.0',
const_attr => '5.22.0',
current_sub => '5.16.0',
declared_refs => '5.26.0',
evalbytes => '5.16.0',
fc => '5.16.0',
isa => '5.31.7',
lexical_topic => '5.10.0',
lexical_subs => '5.18.0',
postderef => '5.20.0',
postderef_qq => '5.20.0',
refaliasing => '5.22.0',
regex_sets => '5.18.0',
say => '5.10.0',
smartmatch => '5.10.0',
signatures => '5.20.0',
state => '5.10.0',
switch => '5.10.0',
unicode_eval => '5.16.0',
unicode_strings => '5.12.0',
);
my %removed_in_version = (
array_base => '5.29.4',
autoderef => '5.23.1',
lexical_topic => '5.23.4',
);
$_ = version->new($_) for values %min_version;
$_ = version->new($_) for values %removed_in_version;
my %additional = (
postderef => ['postderef_qq'],
switch => ['smartmatch'],
declared_refs => ['refaliasing'],
);
sub _enable {
my $pragma = shift;
if ($warnings{"experimental::$pragma"}) {
warnings->unimport("experimental::$pragma");
feature->import($pragma) if exists $features{$pragma};
_enable(@{ $additional{$pragma} }) if $additional{$pragma};
}
elsif ($features{$pragma}) {
feature->import($pragma);
_enable(@{ $additional{$pragma} }) if $additional{$pragma};
}
elsif (not exists $min_version{$pragma}) {
croak "Can't enable unknown feature $pragma";
}
elsif ($] < $min_version{$pragma}) {
my $stable = $min_version{$pragma};
if ($stable->{version}[1] % 2) {
$stable = version->new(
"5.".($stable->{version}[1]+1).'.0'
);
}
croak "Need perl $stable or later for feature $pragma";
}
elsif ($] >= ($removed_in_version{$pragma} || 7)) {
croak "Experimental feature $pragma has been removed from perl in version $removed_in_version{$pragma}";
}
}
sub import {
my ($self, @pragmas) = @_;
for my $pragma (@pragmas) {
_enable($pragma);
}
return;
}
sub _disable {
my $pragma = shift;
if ($warnings{"experimental::$pragma"}) {
warnings->import("experimental::$pragma");
feature->unimport($pragma) if exists $features{$pragma};
_disable(@{ $additional{$pragma} }) if $additional{$pragma};
}
elsif ($features{$pragma}) {
feature->unimport($pragma);
_disable(@{ $additional{$pragma} }) if $additional{$pragma};
}
elsif (not exists $min_version{$pragma}) {
carp "Can't disable unknown feature $pragma, ignoring";
}
}
sub unimport {
my ($self, @pragmas) = @_;
for my $pragma (@pragmas) {
_disable($pragma);
}
return;
}
1;
#ABSTRACT: Experimental features made easy
__END__
=pod
=encoding UTF-8
=head1 NAME
experimental - Experimental features made easy
=head1 VERSION
version 0.022
=head1 SYNOPSIS
use experimental 'lexical_subs', 'smartmatch';
my sub foo { $_[0] ~~ 1 }
=head1 DESCRIPTION
This pragma provides an easy and convenient way to enable or disable
experimental features.
Every version of perl has some number of features present but considered
"experimental." For much of the life of Perl 5, this was only a designation
found in the documentation. Starting in Perl v5.10.0, and more aggressively in
v5.18.0, experimental features were placed behind pragmata used to enable the
feature and disable associated warnings.
The C