1package attributes; 2 3our $VERSION = 0.21; 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 locked 242 243The "locked" attribute is deprecated, and has no effect in 5.10.0 and later. 244It was used as part of the now-removed "Perl 5.005 threads". 245 246=back 247 248The following are the built-in attributes for variables: 249 250=over 4 251 252=item shared 253 254Indicates that the referenced variable can be shared across different threads 255when used in conjunction with the L<threads> and L<threads::shared> modules. 256 257=item unique 258 259The "unique" attribute is deprecated, and has no effect in 5.10.0 and later. 260It used to indicate that a single copy of an C<our> variable was to be used by 261all interpreters should the program happen to be running in a 262multi-interpreter environment. 263 264=back 265 266=head2 Available Subroutines 267 268The following subroutines are available for general use once this module 269has been loaded: 270 271=over 4 272 273=item get 274 275This routine expects a single parameter--a reference to a 276subroutine or variable. It returns a list of attributes, which may be 277empty. If passed invalid arguments, it uses die() (via L<Carp::croak|Carp>) 278to raise a fatal exception. If it can find an appropriate package name 279for a class method lookup, it will include the results from a 280C<FETCH_I<type>_ATTRIBUTES> call in its return list, as described in 281L<"Package-specific Attribute Handling"> below. 282Otherwise, only L<built-in attributes|"Built-in Attributes"> will be returned. 283 284=item reftype 285 286This routine expects a single parameter--a reference to a subroutine or 287variable. It returns the built-in type of the referenced variable, 288ignoring any package into which it might have been blessed. 289This can be useful for determining the I<type> value which forms part of 290the method names described in L<"Package-specific Attribute Handling"> below. 291 292=back 293 294Note that these routines are I<not> exported by default. 295 296=head2 Package-specific Attribute Handling 297 298B<WARNING>: the mechanisms described here are still experimental. Do not 299rely on the current implementation. In particular, there is no provision 300for applying package attributes to 'cloned' copies of subroutines used as 301closures. (See L<perlref/"Making References"> for information on closures.) 302Package-specific attribute handling may change incompatibly in a future 303release. 304 305When an attribute list is present in a declaration, a check is made to see 306whether an attribute 'modify' handler is present in the appropriate package 307(or its @ISA inheritance tree). Similarly, when C<attributes::get> is 308called on a valid reference, a check is made for an appropriate attribute 309'fetch' handler. See L<"EXAMPLES"> to see how the "appropriate package" 310determination works. 311 312The handler names are based on the underlying type of the variable being 313declared or of the reference passed. Because these attributes are 314associated with subroutine or variable declarations, this deliberately 315ignores any possibility of being blessed into some package. Thus, a 316subroutine declaration uses "CODE" as its I<type>, and even a blessed 317hash reference uses "HASH" as its I<type>. 318 319The class methods invoked for modifying and fetching are these: 320 321=over 4 322 323=item FETCH_I<type>_ATTRIBUTES 324 325This method is called with two arguments: the relevant package name, 326and a reference to a variable or subroutine for which package-defined 327attributes are desired. The expected return value is a list of 328associated attributes. This list may be empty. 329 330=item MODIFY_I<type>_ATTRIBUTES 331 332This method is called with two fixed arguments, followed by the list of 333attributes from the relevant declaration. The two fixed arguments are 334the relevant package name and a reference to the declared subroutine or 335variable. The expected return value is a list of attributes which were 336not recognized by this handler. Note that this allows for a derived class 337to delegate a call to its base class, and then only examine the attributes 338which the base class didn't already handle for it. 339 340The call to this method is currently made I<during> the processing of the 341declaration. In particular, this means that a subroutine reference will 342probably be for an undefined subroutine, even if this declaration is 343actually part of the definition. 344 345=back 346 347Calling C<attributes::get()> from within the scope of a null package 348declaration C<package ;> for an unblessed variable reference will 349not provide any starting package name for the 'fetch' method lookup. 350Thus, this circumstance will not result in a method call for package-defined 351attributes. A named subroutine knows to which symbol table entry it belongs 352(or originally belonged), and it will use the corresponding package. 353An anonymous subroutine knows the package name into which it was compiled 354(unless it was also compiled with a null package declaration), and so it 355will use that package name. 356 357=head2 Syntax of Attribute Lists 358 359An attribute list is a sequence of attribute specifications, separated by 360whitespace or a colon (with optional whitespace). 361Each attribute specification is a simple 362name, optionally followed by a parenthesised parameter list. 363If such a parameter list is present, it is scanned past as for the rules 364for the C<q()> operator. (See L<perlop/"Quote and Quote-like Operators">.) 365The parameter list is passed as it was found, however, and not as per C<q()>. 366 367Some examples of syntactically valid attribute lists: 368 369 switch(10,foo(7,3)) : expensive 370 Ugly('\(") :Bad 371 _5x5 372 lvalue method 373 374Some examples of syntactically invalid attribute lists (with annotation): 375 376 switch(10,foo() # ()-string not balanced 377 Ugly('(') # ()-string not balanced 378 5x5 # "5x5" not a valid identifier 379 Y2::north # "Y2::north" not a simple identifier 380 foo + bar # "+" neither a colon nor whitespace 381 382=head1 EXPORTS 383 384=head2 Default exports 385 386None. 387 388=head2 Available exports 389 390The routines C<get> and C<reftype> are exportable. 391 392=head2 Export tags defined 393 394The C<:ALL> tag will get all of the above exports. 395 396=head1 EXAMPLES 397 398Here are some samples of syntactically valid declarations, with annotation 399as to how they resolve internally into C<use attributes> invocations by 400perl. These examples are primarily useful to see how the "appropriate 401package" is found for the possible method lookups for package-defined 402attributes. 403 404=over 4 405 406=item 1. 407 408Code: 409 410 package Canine; 411 package Dog; 412 my Canine $spot : Watchful ; 413 414Effect: 415 416 use attributes (); 417 attributes::->import(Canine => \$spot, "Watchful"); 418 419=item 2. 420 421Code: 422 423 package Felis; 424 my $cat : Nervous; 425 426Effect: 427 428 use attributes (); 429 attributes::->import(Felis => \$cat, "Nervous"); 430 431=item 3. 432 433Code: 434 435 package X; 436 sub foo : lvalue ; 437 438Effect: 439 440 use attributes X => \&foo, "lvalue"; 441 442=item 4. 443 444Code: 445 446 package X; 447 sub Y::x : lvalue { 1 } 448 449Effect: 450 451 use attributes Y => \&Y::x, "lvalue"; 452 453=item 5. 454 455Code: 456 457 package X; 458 sub foo { 1 } 459 460 package Y; 461 BEGIN { *bar = \&X::foo; } 462 463 package Z; 464 sub Y::bar : lvalue ; 465 466Effect: 467 468 use attributes X => \&X::foo, "lvalue"; 469 470=back 471 472This last example is purely for purposes of completeness. You should not 473be trying to mess with the attributes of something in a package that's 474not your own. 475 476=head1 MORE EXAMPLES 477 478=over 4 479 480=item 1. 481 482 sub MODIFY_CODE_ATTRIBUTES { 483 my ($class,$code,@attrs) = @_; 484 485 my $allowed = 'MyAttribute'; 486 my @bad = grep { $_ ne $allowed } @attrs; 487 488 return @bad; 489 } 490 491 sub foo : MyAttribute { 492 print "foo\n"; 493 } 494 495This example runs. At compile time 496C<MODIFY_CODE_ATTRIBUTES> is called. In that 497subroutine, we check if any attribute is disallowed and we return a list of 498these "bad attributes". 499 500As we return an empty list, everything is fine. 501 502=item 2. 503 504 sub MODIFY_CODE_ATTRIBUTES { 505 my ($class,$code,@attrs) = @_; 506 507 my $allowed = 'MyAttribute'; 508 my @bad = grep{ $_ ne $allowed }@attrs; 509 510 return @bad; 511 } 512 513 sub foo : MyAttribute Test { 514 print "foo\n"; 515 } 516 517This example is aborted at compile time as we use the attribute "Test" which 518isn't allowed. C<MODIFY_CODE_ATTRIBUTES> 519returns a list that contains a single 520element ('Test'). 521 522=back 523 524=head1 SEE ALSO 525 526L<perlsub/"Private Variables via my()"> and 527L<perlsub/"Subroutine Attributes"> for details on the basic declarations; 528L<perlfunc/use> for details on the normal invocation mechanism. 529 530=cut 531