Update to PathTools-3.22.

[p5sagit/p5-mst-13.2.git] / lib / feature.pm

diff --git a/lib/feature.pm b/lib/feature.pm
index fe54994..238820e 100644 (file)
--- 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;