X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Ffeature.pm;h=238820e72311ff34f310078f19012e6113be7db2;hb=81a4c762684cf629f6e7986fe1827ecd2af35ba2;hp=fe549944bcca6dd046f16c9401d2ed0ed4d19585;hpb=7b9ef14019d3c4d1aa14641dbd421c81c2cd18a4;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/feature.pm b/lib/feature.pm
index fe54994..238820e 100644
--- a/lib/feature.pm
+++ b/lib/feature.pm
@@ -1,13 +1,19 @@
 package feature;
 
-our $VERSION = '1.00';
-$feature::hint_bits = 0x04020000; # HINT_LOCALIZE_HH | HINT_HH_FOR_EVAL
+our $VERSION = '1.01';
 
 # (feature name) => (internal name, used in %^H)
 my %feature = (
     switch => 'feature_switch',
     "~~"   => "feature_~~",
     say    => "feature_say",
+    err    => "feature_err",
+    dor    => "feature_err",
+    state  => "feature_state",
+);
+
+my %feature_bundle = (
+    "5.10" => [qw(switch ~~ say err state)],
 );
 
 
@@ -31,13 +37,13 @@ feature - Perl pragma to enable new syntactic features
 
 =head1 SYNOPSIS
 
-    use feature 'switch';
+    use feature qw(switch say);
     given ($foo) {
-	when (1)	  { print "\$foo == 1\n" }
-	when ([2,3])	  { print "\$foo == 2 || \$foo == 3\n" }
-	when (/^a[bc]d$/) { print "\$foo eq 'abd' || \$foo eq 'acd'\n" }
-	when ($_ > 100)   { print "\$foo > 100\n" }
-	default		  { print "None of the above\n" }
+	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" }
     }
 
 =head1 DESCRIPTION
@@ -69,11 +75,34 @@ C<say> function from here to the end of the enclosing BLOCK.
 
 See L<perlfunc/say> for details.
 
+=head2 the 'err' feature
+
+C<use feature 'err'> tells the compiler to enable the C<err>
+operator from here to the end of the enclosing BLOCK.
+
+C<err> is a low-precedence variant of the C<//> operator:
+see C<perlop> for details.
+
+=head2 the 'dor' feature
+
+The 'dor' feature is an alias for the 'err' feature.
+
+=head2 the 'state' feature
+
+C<use feature 'state'> tells the compiler to enable C<state>
+variables from here to the end of the enclosing BLOCK.
+
+=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 bundle is C<use feature ":5.10">, which is equivalent
+to C<use feature qw(switch ~~ say err state)>.
+
 =cut
 
 sub import {
-    $^H |= $feature::hint_bits;	# Need this or %^H won't work
-
     my $class = shift;
     if (@_ == 0) {
 	require Carp;
@@ -82,6 +111,16 @@ sub import {
     }
     while (@_) {
 	my $name = shift(@_);
+	if ($name =~ /^:(.*)/) {
+	    if (!exists $feature_bundle{$1}) {
+		require Carp;
+		Carp->import("croak");
+		croak(sprintf('Feature bundle "%s" is not supported by Perl %vd',
+		    $1, $^V));
+	    }
+	    unshift @_, @{$feature_bundle{$1}};
+	    next;
+	}
 	if (!exists $feature{$name}) {
 	    require Carp;
 	    Carp->import("croak");
@@ -96,7 +135,23 @@ sub unimport {
     my $class = shift;
 
     # A bare C<no feature> should disable *all* features
-    for my $name (@_) {
+    if (!@_) {
+	delete @^H{ values(%feature) };
+	return;
+    }
+
+    while (@_) {
+	my $name = shift;
+	if ($name =~ /^:(.*)/) {
+	    if (!exists $feature_bundle{$1}) {
+		require Carp;
+		Carp->import("croak");
+		croak(sprintf('Feature bundle "%s" is not supported by Perl %vd',
+		    $1, $^V));
+	    }
+	    unshift @_, @{$feature_bundle{$1}};
+	    next;
+	}
 	if (!exists($feature{$name})) {
 	    require Carp;
 	    Carp->import("croak");
@@ -107,10 +162,6 @@ sub unimport {
 	    delete $^H{$feature{$name}};
 	}
     }
-
-    if(!@_) {
-	delete @^H{ values(%feature) };
-    }
 }
 
 1;