1package attributes; 2 3our $VERSION = 0.23; 4 5@EXPORT_OK = qw(get reftype); 6@EXPORT = (); 7%EXPORT_TAGS = (ALL => [@EXPORT, @EXPORT_OK]); 8 9use strict; 10 11sub croak { 12 require Carp; 13 goto &Carp::croak; 14} 15 16sub carp { 17 require Carp; 18 goto &Carp::carp; 19} 20 21my %deprecated; 22$deprecated{CODE} = qr/\A-?(locked)\z/; 23$deprecated{ARRAY} = $deprecated{HASH} = $deprecated{SCALAR} 24 = qr/\A-?(unique)\z/; 25 26sub _modify_attrs_and_deprecate { 27 my $svtype = shift; 28 # Now that we've removed handling of locked from the XS code, we need to 29 # remove it here, else it ends up in @badattrs. (If we do the deprecation in 30 # XS, we can't control the warning based on *our* caller's lexical settings, 31 # and the warned line is in this package) 32 grep { 33 $deprecated{$svtype} && /$deprecated{$svtype}/ ? do { 34 require warnings; 35 warnings::warnif('deprecated', "Attribute \"$1\" is deprecated"); 36 0; 37 } : $svtype eq 'CODE' && /^-?lvalue\z/ ? do { 38 require warnings; 39 warnings::warnif( 40 'misc', 41 "lvalue attribute " 42 . (/^-/ ? "removed from" : "applied to") 43 . " already-defined subroutine" 44 ); 45 0; 46 } : 1 47 } _modify_attrs(@_); 48} 49 50sub import { 51 @_ > 2 && ref $_[2] or do { 52 require Exporter; 53 goto &Exporter::import; 54 }; 55 my (undef,$home_stash,$svref,@attrs) = @_; 56 57 my $svtype = uc reftype($svref); 58 my $pkgmeth; 59 $pkgmeth = UNIVERSAL::can($home_stash, "MODIFY_${svtype}_ATTRIBUTES") 60 if defined $home_stash && $home_stash ne ''; 61 my @badattrs; 62 if ($pkgmeth) { 63 my @pkgattrs = _modify_attrs_and_deprecate($svtype, $svref, @attrs); 64 @badattrs = $pkgmeth->($home_stash, $svref, @pkgattrs); 65 if (!@badattrs && @pkgattrs) { 66 require warnings; 67 return unless warnings::enabled('reserved'); 68 @pkgattrs = grep { m/\A[[:lower:]]+(?:\z|\()/ } @pkgattrs; 69 if (@pkgattrs) { 70 for my $attr (@pkgattrs) { 71 $attr =~ s/\(.+\z//s; 72 } 73 my $s = ((@pkgattrs == 1) ? '' : 's'); 74 carp "$svtype package attribute$s " . 75 "may clash with future reserved word$s: " . 76 join(' : ' , @pkgattrs); 77 } 78 } 79 } 80 else { 81 @badattrs = _modify_attrs_and_deprecate($svtype, $svref, @attrs); 82 } 83 if (@badattrs) { 84 croak "Invalid $svtype attribute" . 85 (( @badattrs == 1 ) ? '' : 's') . 86 ": " . 87 join(' : ', @badattrs); 88 } 89} 90 91sub get ($) { 92 @_ == 1 && ref $_[0] or 93 croak 'Usage: '.__PACKAGE__.'::get $ref'; 94 my $svref = shift; 95 my $svtype = uc reftype($svref); 96 my $stash = _guess_stash($svref); 97 $stash = caller unless defined $stash; 98 my $pkgmeth; 99 $pkgmeth = UNIVERSAL::can($stash, "FETCH_${svtype}_ATTRIBUTES") 100 if defined $stash && $stash ne ''; 101 return $pkgmeth ? 102 (_fetch_attrs($svref), $pkgmeth->($stash, $svref)) : 103 (_fetch_attrs($svref)) 104 ; 105} 106 107sub require_version { goto &UNIVERSAL::VERSION } 108 109require XSLoader; 110XSLoader::load(); 111 1121; 113__END__ 114#The POD goes here 115 116=head1 NAME 117 118attributes - get/set subroutine or variable attributes 119 120=head1 SYNOPSIS 121 122 sub foo : method ; 123 my ($x,@y,%z) : Bent = 1; 124 my $s = sub : method { ... }; 125 126 use attributes (); # optional, to get subroutine declarations 127 my @attrlist = attributes::get(\&foo); 128 129 use attributes 'get'; # import the attributes::get subroutine 130 my @attrlist = get \&foo; 131 132=head1 DESCRIPTION 133 134Subroutine declarations and definitions may optionally have attribute lists 135associated with them. (Variable C<my> declarations also may, but see the 136warning below.) Perl handles these declarations by passing some information 137about the call site and the thing being declared along with the attribute 138list to this module. In particular, the first example above is equivalent to 139the following: 140 141 use attributes __PACKAGE__, \&foo, 'method'; 142 143The second example in the synopsis does something equivalent to this: 144 145 use attributes (); 146 my ($x,@y,%z); 147 attributes::->import(__PACKAGE__, \$x, 'Bent'); 148 attributes::->import(__PACKAGE__, \@y, 'Bent'); 149 attributes::->import(__PACKAGE__, \%z, 'Bent'); 150 ($x,@y,%z) = 1; 151 152Yes, that's a lot of expansion. 153 154B<WARNING>: attribute declarations for variables are still evolving. 155The semantics and interfaces of such declarations could change in 156future versions. They are present for purposes of experimentation 157with what the semantics ought to be. Do not rely on the current 158implementation of this feature. 159 160There are only a few attributes currently handled by Perl itself (or 161directly by this module, depending on how you look at it.) However, 162package-specific attributes are allowed by an extension mechanism. 163(See L<"Package-specific Attribute Handling"> below.) 164 165The setting of subroutine attributes happens at compile time. 166Variable attributes in C<our> declarations are also applied at compile time. 167However, C<my> variables get their attributes applied at run-time. 168This means that you have to I<reach> the run-time component of the C<my> 169before those attributes will get applied. For example: 170 171 my $x : Bent = 42 if 0; 172 173will neither assign 42 to $x I<nor> will it apply the C<Bent> attribute 174to the variable. 175 176An attempt to set an unrecognized attribute is a fatal error. (The 177error is trappable, but it still stops the compilation within that 178C<eval>.) Setting an attribute with a name that's all lowercase 179letters that's not a built-in attribute (such as "foo") will result in 180a warning with B<-w> or C<use warnings 'reserved'>. 181 182=head2 What C<import> does 183 184In the description it is mentioned that 185 186 sub foo : method; 187 188is equivalent to 189 190 use attributes __PACKAGE__, \&foo, 'method'; 191 192As you might know this calls the C<import> function of C<attributes> at compile 193time with these parameters: 'attributes', the caller's package name, the reference 194to the code and 'method'. 195 196 attributes->import( __PACKAGE__, \&foo, 'method' ); 197 198So you want to know what C<import> actually does? 199 200First of all C<import> gets the type of the third parameter ('CODE' in this case). 201C<attributes.pm> checks if there is a subroutine called C<< MODIFY_<reftype>_ATTRIBUTES >> 202in the caller's namespace (here: 'main'). In this case a 203subroutine C<MODIFY_CODE_ATTRIBUTES> is required. Then this 204method is called to check if you have used a "bad attribute". 205The subroutine call in this example would look like 206 207 MODIFY_CODE_ATTRIBUTES( 'main', \&foo, 'method' ); 208 209C<< MODIFY_<reftype>_ATTRIBUTES >> has to return a list of all "bad attributes". 210If there are any bad attributes C<import> croaks. 211 212(See L<"Package-specific Attribute Handling"> below.) 213 214=head2 Built-in Attributes 215 216The following are the built-in attributes for subroutines: 217 218=over 4 219 220=item lvalue 221 222Indicates that the referenced subroutine is a valid lvalue and can 223be assigned to. The subroutine must return a modifiable value such 224as a scalar variable, as described in L<perlsub>. 225 226This module allows one to set this attribute on a subroutine that is 227already defined. For Perl subroutines (XSUBs are fine), it may or may not 228do what you want, depending on the code inside the subroutine, with details 229subject to change in future Perl versions. You may run into problems with 230lvalue context not being propagated properly into the subroutine, or maybe 231even assertion failures. For this reason, a warning is emitted if warnings 232are enabled. In other words, you should only do this if you really know 233what you are doing. You have been warned. 234 235=item method 236 237Indicates that the referenced subroutine 238is a method. A subroutine so marked 239will not trigger the "Ambiguous call resolved as CORE::%s" warning. 240 241=item prototype(..) 242 243The "prototype" attribute is an alternate means of specifying a prototype 244on a sub. The desired prototype is within the parens. 245 246The prototype from the attribute is assigned to the sub immediately after 247the prototype from the sub, which means that if both are declared at the 248same time, the traditionally defined prototype is ignored. In other words, 249C<sub foo($$) : prototype(@) {}> is indistinguishable from C<sub foo(@){}>. 250 251If illegalproto warnings are enabled, the prototype declared inside this 252attribute will be sanity checked at compile time. 253 254=item locked 255 256The "locked" attribute is deprecated, and has no effect in 5.10.0 and later. 257It was used as part of the now-removed "Perl 5.005 threads". 258 259=back 260 261The following are the built-in attributes for variables: 262 263=over 4 264 265=item shared 266 267Indicates that the referenced variable can be shared across different threads 268when used in conjunction with the L<threads> and L<threads::shared> modules. 269 270=item unique 271 272The "unique" attribute is deprecated, and has no effect in 5.10.0 and later. 273It used to indicate that a single copy of an C<our> variable was to be used by 274all interpreters should the program happen to be running in a 275multi-interpreter environment. 276 277=back 278 279=head2 Available Subroutines 280 281The following subroutines are available for general use once this module 282has been loaded: 283 284=over 4 285 286=item get 287 288This routine expects a single parameter--a reference to a 289subroutine or variable. It returns a list of attributes, which may be 290empty. If passed invalid arguments, it uses die() (via L<Carp::croak|Carp>) 291to raise a fatal exception. If it can find an appropriate package name 292for a class method lookup, it will include the results from a 293C<FETCH_I<type>_ATTRIBUTES> call in its return list, as described in 294L<"Package-specific Attribute Handling"> below. 295Otherwise, only L<built-in attributes|"Built-in Attributes"> will be returned. 296 297=item reftype 298 299This routine expects a single parameter--a reference to a subroutine or 300variable. It returns the built-in type of the referenced variable, 301ignoring any package into which it might have been blessed. 302This can be useful for determining the I<type> value which forms part of 303the method names described in L<"Package-specific Attribute Handling"> below. 304 305=back 306 307Note that these routines are I<not> exported by default. 308 309=head2 Package-specific Attribute Handling 310 311B<WARNING>: the mechanisms described here are still experimental. Do not 312rely on the current implementation. In particular, there is no provision 313for applying package attributes to 'cloned' copies of subroutines used as 314closures. (See L<perlref/"Making References"> for information on closures.) 315Package-specific attribute handling may change incompatibly in a future 316release. 317 318When an attribute list is present in a declaration, a check is made to see 319whether an attribute 'modify' handler is present in the appropriate package 320(or its @ISA inheritance tree). Similarly, when C<attributes::get> is 321called on a valid reference, a check is made for an appropriate attribute 322'fetch' handler. See L<"EXAMPLES"> to see how the "appropriate package" 323determination works. 324 325The handler names are based on the underlying type of the variable being 326declared or of the reference passed. Because these attributes are 327associated with subroutine or variable declarations, this deliberately 328ignores any possibility of being blessed into some package. Thus, a 329subroutine declaration uses "CODE" as its I<type>, and even a blessed 330hash reference uses "HASH" as its I<type>. 331 332The class methods invoked for modifying and fetching are these: 333 334=over 4 335 336=item FETCH_I<type>_ATTRIBUTES 337 338This method is called with two arguments: the relevant package name, 339and a reference to a variable or subroutine for which package-defined 340attributes are desired. The expected return value is a list of 341associated attributes. This list may be empty. 342 343=item MODIFY_I<type>_ATTRIBUTES 344 345This method is called with two fixed arguments, followed by the list of 346attributes from the relevant declaration. The two fixed arguments are 347the relevant package name and a reference to the declared subroutine or 348variable. The expected return value is a list of attributes which were 349not recognized by this handler. Note that this allows for a derived class 350to delegate a call to its base class, and then only examine the attributes 351which the base class didn't already handle for it. 352 353The call to this method is currently made I<during> the processing of the 354declaration. In particular, this means that a subroutine reference will 355probably be for an undefined subroutine, even if this declaration is 356actually part of the definition. 357 358=back 359 360Calling C<attributes::get()> from within the scope of a null package 361declaration C<package ;> for an unblessed variable reference will 362not provide any starting package name for the 'fetch' method lookup. 363Thus, this circumstance will not result in a method call for package-defined 364attributes. A named subroutine knows to which symbol table entry it belongs 365(or originally belonged), and it will use the corresponding package. 366An anonymous subroutine knows the package name into which it was compiled 367(unless it was also compiled with a null package declaration), and so it 368will use that package name. 369 370=head2 Syntax of Attribute Lists 371 372An attribute list is a sequence of attribute specifications, separated by 373whitespace or a colon (with optional whitespace). 374Each attribute specification is a simple 375name, optionally followed by a parenthesised parameter list. 376If such a parameter list is present, it is scanned past as for the rules 377for the C<q()> operator. (See L<perlop/"Quote and Quote-like Operators">.) 378The parameter list is passed as it was found, however, and not as per C<q()>. 379 380Some examples of syntactically valid attribute lists: 381 382 switch(10,foo(7,3)) : expensive 383 Ugly('\(") :Bad 384 _5x5 385 lvalue method 386 387Some examples of syntactically invalid attribute lists (with annotation): 388 389 switch(10,foo() # ()-string not balanced 390 Ugly('(') # ()-string not balanced 391 5x5 # "5x5" not a valid identifier 392 Y2::north # "Y2::north" not a simple identifier 393 foo + bar # "+" neither a colon nor whitespace 394 395=head1 EXPORTS 396 397=head2 Default exports 398 399None. 400 401=head2 Available exports 402 403The routines C<get> and C<reftype> are exportable. 404 405=head2 Export tags defined 406 407The C<:ALL> tag will get all of the above exports. 408 409=head1 EXAMPLES 410 411Here are some samples of syntactically valid declarations, with annotation 412as to how they resolve internally into C<use attributes> invocations by 413perl. These examples are primarily useful to see how the "appropriate 414package" is found for the possible method lookups for package-defined 415attributes. 416 417=over 4 418 419=item 1. 420 421Code: 422 423 package Canine; 424 package Dog; 425 my Canine $spot : Watchful ; 426 427Effect: 428 429 use attributes (); 430 attributes::->import(Canine => \$spot, "Watchful"); 431 432=item 2. 433 434Code: 435 436 package Felis; 437 my $cat : Nervous; 438 439Effect: 440 441 use attributes (); 442 attributes::->import(Felis => \$cat, "Nervous"); 443 444=item 3. 445 446Code: 447 448 package X; 449 sub foo : lvalue ; 450 451Effect: 452 453 use attributes X => \&foo, "lvalue"; 454 455=item 4. 456 457Code: 458 459 package X; 460 sub Y::x : lvalue { 1 } 461 462Effect: 463 464 use attributes Y => \&Y::x, "lvalue"; 465 466=item 5. 467 468Code: 469 470 package X; 471 sub foo { 1 } 472 473 package Y; 474 BEGIN { *bar = \&X::foo; } 475 476 package Z; 477 sub Y::bar : lvalue ; 478 479Effect: 480 481 use attributes X => \&X::foo, "lvalue"; 482 483=back 484 485This last example is purely for purposes of completeness. You should not 486be trying to mess with the attributes of something in a package that's 487not your own. 488 489=head1 MORE EXAMPLES 490 491=over 4 492 493=item 1. 494 495 sub MODIFY_CODE_ATTRIBUTES { 496 my ($class,$code,@attrs) = @_; 497 498 my $allowed = 'MyAttribute'; 499 my @bad = grep { $_ ne $allowed } @attrs; 500 501 return @bad; 502 } 503 504 sub foo : MyAttribute { 505 print "foo\n"; 506 } 507 508This example runs. At compile time 509C<MODIFY_CODE_ATTRIBUTES> is called. In that 510subroutine, we check if any attribute is disallowed and we return a list of 511these "bad attributes". 512 513As we return an empty list, everything is fine. 514 515=item 2. 516 517 sub MODIFY_CODE_ATTRIBUTES { 518 my ($class,$code,@attrs) = @_; 519 520 my $allowed = 'MyAttribute'; 521 my @bad = grep{ $_ ne $allowed }@attrs; 522 523 return @bad; 524 } 525 526 sub foo : MyAttribute Test { 527 print "foo\n"; 528 } 529 530This example is aborted at compile time as we use the attribute "Test" which 531isn't allowed. C<MODIFY_CODE_ATTRIBUTES> 532returns a list that contains a single 533element ('Test'). 534 535=back 536 537=head1 SEE ALSO 538 539L<perlsub/"Private Variables via my()"> and 540L<perlsub/"Subroutine Attributes"> for details on the basic declarations; 541L<perlfunc/use> for details on the normal invocation mechanism. 542 543=cut 544