pumpkin.pod: Add L<> around html link

[perl5.git] / ext / attributes / attributes.pm

diff --git a/ext/attributes/attributes.pm b/ext/attributes/attributes.pm
index 701ff1b..a7c6716 100644 (file)
--- a/ext/attributes/attributes.pm
+++ b/ext/attributes/attributes.pm
@@ -1,6 +1,6 @@
 package attributes;
 
-our $VERSION = 0.11;
+our $VERSION = 0.15;
 
 @EXPORT_OK = qw(get reftype);
 @EXPORT = ();
@@ -18,6 +18,35 @@ sub carp {
     goto &Carp::carp;
 }
 
+my %deprecated;
+$deprecated{CODE} = qr/\A-?(locked)\z/;
+$deprecated{ARRAY} = $deprecated{HASH} = $deprecated{SCALAR}
+    = qr/\A-?(unique)\z/;
+
+sub _modify_attrs_and_deprecate {
+    my $svtype = shift;
+    # Now that we've removed handling of locked from the XS code, we need to
+    # remove it here, else it ends up in @badattrs. (If we do the deprecation in
+    # XS, we can't control the warning based on *our* caller's lexical settings,
+    # and the warned line is in this package)
+    grep {
+       $deprecated{$svtype} && /$deprecated{$svtype}/ ? do {
+           require warnings;
+           warnings::warnif('deprecated', "Attribute \"$1\" is deprecated");
+           0;
+       } : $svtype eq 'CODE' && /^-?lvalue\z/ ? do {
+           require warnings;
+           warnings::warnif(
+               'misc',
+               "lvalue attribute "
+                  . (/^-/ ? "cannot be removed" : "ignored")
+                  . " after the subroutine has been defined"
+           );
+           0;
+       } : 1
+    } _modify_attrs(@_);
+}
+
 sub import {
     @_ > 2 && ref $_[2] or do {
        require Exporter;
@@ -31,7 +60,7 @@ sub import {
        if defined $home_stash && $home_stash ne '';
     my @badattrs;
     if ($pkgmeth) {
-       my @pkgattrs = _modify_attrs($svref, @attrs);
+       my @pkgattrs = _modify_attrs_and_deprecate($svtype, $svref, @attrs);
        @badattrs = $pkgmeth->($home_stash, $svref, @pkgattrs);
        if (!@badattrs && @pkgattrs) {
             require warnings;
@@ -49,7 +78,7 @@ sub import {
        }
     }
     else {
-       @badattrs = _modify_attrs($svref, @attrs);
+       @badattrs = _modify_attrs_and_deprecate($svtype, $svref, @attrs);
     }
     if (@badattrs) {
        croak "Invalid $svtype attribute" .
@@ -78,7 +107,7 @@ sub get ($) {
 sub require_version { goto &UNIVERSAL::VERSION }
 
 require XSLoader;
-XSLoader::load('attributes', $VERSION);
+XSLoader::load();
 
 1;
 __END__
@@ -205,8 +234,6 @@ of the now-removed "Perl 5.005 threads".
 
 =back
 
-For global variables there is C<unique> attribute: see L<perlfunc/our>.
-
 =head2 Available Subroutines
 
 The following subroutines are available for general use once this module
@@ -313,7 +340,7 @@ Some examples of syntactically valid attribute lists:
     switch(10,foo(7,3))  :  expensive
     Ugly('\(") :Bad
     _5x5
-    locked method
+    lvalue method
 
 Some examples of syntactically invalid attribute lists (with annotation):
 
@@ -377,22 +404,22 @@ Effect:
 Code:
 
     package X;
-    sub foo : locked ;
+    sub foo : lvalue ;
 
 Effect:
 
-    use attributes X => \&foo, "locked";
+    use attributes X => \&foo, "lvalue";
 
 =item 4.
 
 Code:
 
     package X;
-    sub Y::x : locked { 1 }
+    sub Y::x : lvalue { 1 }
 
 Effect:
 
-    use attributes Y => \&Y::x, "locked";
+    use attributes Y => \&Y::x, "lvalue";
 
 =item 5.
 
@@ -405,11 +432,11 @@ Code:
     BEGIN { *bar = \&X::foo; }
 
     package Z;
-    sub Y::bar : locked ;
+    sub Y::bar : lvalue ;
 
 Effect:
 
-    use attributes X => \&X::foo, "locked";
+    use attributes X => \&X::foo, "lvalue";
 
 =back
 
@@ -467,8 +494,6 @@ element ('Test').
 
 L<perlsub/"Private Variables via my()"> and
 L<perlsub/"Subroutine Attributes"> for details on the basic declarations;
-L<attrs> for the obsolescent form of subroutine attribute specification
-which this module replaces;
 L<perlfunc/use> for details on the normal invocation mechanism.
 
 =cut